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