1. my class X::Bind { ... }
  2. my class X::Caller::NotDynamic { ... }
  3. my class PseudoStash is Map {
  4. has Mu $!ctx;
  5. has int $!mode;
  6. # Lookup modes.
  7. my int constant PICK_CHAIN_BY_NAME = 0;
  8. my int constant STATIC_CHAIN = 1;
  9. my int constant DYNAMIC_CHAIN = 2;
  10. my int constant PRECISE_SCOPE = 4;
  11. my int constant REQUIRE_DYNAMIC = 8;
  12. method new() {
  13. my $obj := nqp::create(self);
  14. my $ctx := nqp::ctxcaller(nqp::ctx());
  15. nqp::bindattr($obj, PseudoStash, '$!ctx', $ctx);
  16. nqp::bindattr($obj, Map, '$!storage', nqp::ctxlexpad($ctx));
  17. $obj
  18. }
  19. my %pseudoers =
  20. 'MY' => sub ($cur) {
  21. my $stash := nqp::clone($cur);
  22. nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
  23. nqp::setwho(
  24. Metamodel::ModuleHOW.new_type(:name('MY')),
  25. $stash);
  26. },
  27. 'CORE' => sub ($cur) {
  28. my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx');
  29. until nqp::existskey(nqp::ctxlexpad($ctx), '!CORE_MARKER') {
  30. $ctx := nqp::ctxouterskipthunks($ctx);
  31. }
  32. my $stash := nqp::create(PseudoStash);
  33. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  34. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  35. nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
  36. nqp::setwho(
  37. Metamodel::ModuleHOW.new_type(:name('CORE')),
  38. $stash);
  39. },
  40. 'CALLER' => sub ($cur) {
  41. my Mu $ctx := nqp::ctxcallerskipthunks(
  42. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
  43. my $stash := nqp::create(PseudoStash);
  44. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  45. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  46. nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC);
  47. nqp::setwho(
  48. Metamodel::ModuleHOW.new_type(:name('CALLER')),
  49. $stash);
  50. },
  51. 'OUTER' => sub ($cur) {
  52. my Mu $ctx := nqp::ctxouterskipthunks(
  53. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
  54. my $stash := nqp::create(PseudoStash);
  55. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  56. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  57. nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
  58. nqp::setwho(
  59. Metamodel::ModuleHOW.new_type(:name('OUTER')),
  60. $stash);
  61. },
  62. 'LEXICAL' => sub ($cur) {
  63. my $stash := nqp::clone($cur);
  64. nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN);
  65. nqp::setwho(
  66. Metamodel::ModuleHOW.new_type(:name('LEXICAL')),
  67. $stash);
  68. },
  69. 'OUTERS' => sub ($cur) {
  70. my Mu $ctx := nqp::ctxouterskipthunks(
  71. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
  72. my $stash := nqp::create(PseudoStash);
  73. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  74. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  75. nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN);
  76. nqp::setwho(
  77. Metamodel::ModuleHOW.new_type(:name('OUTERS')),
  78. $stash);
  79. },
  80. 'DYNAMIC' => sub ($cur) {
  81. my $stash := nqp::clone($cur);
  82. nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN);
  83. nqp::setwho(
  84. Metamodel::ModuleHOW.new_type(:name('DYNAMIC')),
  85. $stash);
  86. },
  87. 'CALLERS' => sub ($cur) {
  88. my Mu $ctx := nqp::ctxcallerskipthunks(
  89. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
  90. my $stash := nqp::create(PseudoStash);
  91. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  92. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  93. nqp::bindattr_i($stash, PseudoStash, '$!mode', DYNAMIC_CHAIN +| REQUIRE_DYNAMIC);
  94. nqp::setwho(
  95. Metamodel::ModuleHOW.new_type(:name('CALLERS')),
  96. $stash);
  97. },
  98. 'UNIT' => sub ($cur) {
  99. my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx');
  100. until nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') {
  101. $ctx := nqp::ctxouterskipthunks($ctx);
  102. }
  103. my $stash := nqp::create(PseudoStash);
  104. nqp::bindattr($stash, Map, '$!storage',nqp::ctxlexpad($ctx));
  105. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  106. nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
  107. nqp::setwho(
  108. Metamodel::ModuleHOW.new_type(:name('UNIT')),
  109. $stash);
  110. },
  111. 'SETTING' => sub ($cur) {
  112. # Same as UNIT, but go a little further out (two steps, for
  113. # internals reasons).
  114. my Mu $ctx := nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx');
  115. until nqp::existskey(nqp::ctxlexpad($ctx), '!UNIT_MARKER') {
  116. $ctx := nqp::ctxouterskipthunks($ctx);
  117. }
  118. $ctx := nqp::ctxouter(nqp::ctxouter($ctx));
  119. my $stash := nqp::create(PseudoStash);
  120. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  121. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  122. nqp::bindattr_i($stash, PseudoStash, '$!mode', STATIC_CHAIN);
  123. nqp::setwho(
  124. Metamodel::ModuleHOW.new_type(:name('SETTING')),
  125. $stash);
  126. },
  127. 'CLIENT' => sub ($cur) {
  128. my $pkg := nqp::getlexrel(
  129. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'),
  130. '$?PACKAGE');
  131. die "GLOBAL can have no client package" if $pkg.^name eq "GLOBAL";
  132. my Mu $ctx := nqp::ctxcallerskipthunks(
  133. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'));
  134. while nqp::getlexrel($ctx, '$?PACKAGE') === $pkg {
  135. $ctx := nqp::ctxcallerskipthunks($ctx);
  136. die "No client package found" unless $ctx;
  137. }
  138. my $stash := nqp::create(PseudoStash);
  139. nqp::bindattr($stash, Map, '$!storage', nqp::ctxlexpad($ctx));
  140. nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
  141. nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC);
  142. nqp::setwho(
  143. Metamodel::ModuleHOW.new_type(:name('CLIENT')),
  144. $stash);
  145. },
  146. 'OUR' => sub ($cur) {
  147. nqp::getlexrel(
  148. nqp::getattr(nqp::decont($cur), PseudoStash, '$!ctx'),
  149. '$?PACKAGE')
  150. };
  151. multi method AT-KEY(PseudoStash:D: Str() $key) is raw {
  152. nqp::if(
  153. %pseudoers.EXISTS-KEY($key),
  154. %pseudoers.AT-KEY($key)(self),
  155. nqp::if(
  156. nqp::bitand_i($!mode,PRECISE_SCOPE),
  157. nqp::stmts(
  158. (my Mu $res := nqp::if(
  159. nqp::existskey(
  160. nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)),
  161. nqp::atkey(
  162. nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)),
  163. Nil
  164. )),
  165. nqp::if(
  166. (nqp::not_i(nqp::eqaddr($res,Nil))
  167. && nqp::bitand_i($!mode,REQUIRE_DYNAMIC)),
  168. nqp::if(
  169. (try nqp::not_i($res.VAR.dynamic)),
  170. X::Caller::NotDynamic.new(symbol => $key).throw
  171. )
  172. ),
  173. $res
  174. ),
  175. nqp::if(
  176. nqp::bitand_i(
  177. $!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)
  178. ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*"
  179. nqp::ifnull(
  180. nqp::getlexreldyn(
  181. nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)),
  182. Nil
  183. ),
  184. nqp::ifnull( # STATIC_CHAIN
  185. nqp::getlexrel(
  186. nqp::getattr(self,PseudoStash,'$!ctx'),nqp::unbox_s($key)),
  187. Nil
  188. )
  189. )
  190. )
  191. )
  192. }
  193. method BIND-KEY(Str() $key, \value) is raw {
  194. nqp::if(
  195. %pseudoers.EXISTS-KEY($key),
  196. X::Bind.new(target => "pseudo-package $key").throw,
  197. nqp::if(
  198. nqp::bitand_i($!mode,PRECISE_SCOPE),
  199. nqp::bindkey(
  200. nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key),value),
  201. nqp::if(
  202. nqp::bitand_i(
  203. $!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)
  204. ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*"
  205. (die "Binding to dynamic variables not yet implemented"),
  206. (die "This case of binding is not yet implemented") # STATIC_CHAIN
  207. )
  208. )
  209. )
  210. }
  211. # for some reason we get a ambiguous dispatch error by making this a multi
  212. method EXISTS-KEY(PseudoStash:D: Str() $key) {
  213. nqp::unless(
  214. %pseudoers.EXISTS-KEY($key),
  215. nqp::p6bool(
  216. nqp::if(
  217. nqp::bitand_i($!mode,PRECISE_SCOPE),
  218. nqp::existskey(
  219. nqp::getattr(self,Map,'$!storage'),nqp::unbox_s($key)),
  220. nqp::if(
  221. nqp::bitand_i(
  222. $!mode,nqp::bitor_i(DYNAMIC_CHAIN,PICK_CHAIN_BY_NAME)
  223. ) && nqp::iseq_i(nqp::ord(nqp::unbox_s($key),1),42), # "*"
  224. nqp::not_i(
  225. nqp::isnull(
  226. nqp::getlexreldyn(
  227. nqp::getattr(self, PseudoStash, '$!ctx'),
  228. nqp::unbox_s($key)))),
  229. nqp::not_i( # STATIC_CHAIN
  230. nqp::isnull(
  231. nqp::getlexrel(
  232. nqp::getattr(self, PseudoStash, '$!ctx'),
  233. nqp::unbox_s($key))))
  234. )
  235. )
  236. )
  237. )
  238. }
  239. }