support for "is dynamic" and CALLER:: whining.

rakudo · Aug 11, 2013 · 99993ee · 99993ee
1 parent 8c1cc2b
commit 99993ee
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 14 deletions.
diff --git a/src/Perl6/Metamodel/ContainerDescriptor.nqp b/src/Perl6/Metamodel/ContainerDescriptor.nqp
@@ -3,6 +3,7 @@ class Perl6::Metamodel::ContainerDescriptor {
     has int $!rw;
     has str $!name;
     has     $!default;
+    has int $!dynamic;
 
     method BUILD(:$of, :$rw, :$name, :$default) {
         $!of := $of;
@@ -15,10 +16,12 @@ class Perl6::Metamodel::ContainerDescriptor {
     method rw() { $!rw }
     method name() { $!name }
     method default() { $!default }
+    method dynamic() { $!dynamic }
 
     method set_of($of) { $!of := $of }
     method set_rw($rw) { $!rw := $rw }
     method set_default($default) { $!default := $default }
+    method set_dynamic($dynamic) { $!dynamic := $dynamic }
 
     method is_generic() {
         $!of.HOW.archetypes.generic

diff --git a/src/core/PseudoStash.pm b/src/core/PseudoStash.pm
@@ -8,7 +8,8 @@ my class PseudoStash is EnumMap {
     my int constant PICK_CHAIN_BY_NAME = 0;
     my int constant STATIC_CHAIN       = 1;
     my int constant DYNAMIC_CHAIN      = 2;
-    my int constant PRECISE_SCOPE      = 3;
+    my int constant PRECISE_SCOPE      = 4;
+    my int constant REQUIRE_DYNAMIC    = 8;
 
     method new() {
         my $obj := nqp::create(self);
@@ -45,7 +46,7 @@ my class PseudoStash is EnumMap {
             my $stash := nqp::create(PseudoStash);
             nqp::bindattr($stash, EnumMap, '$!storage', nqp::ctxlexpad($ctx));
             nqp::bindattr($stash, PseudoStash, '$!ctx', $ctx);
-            nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE);
+            nqp::bindattr_i($stash, PseudoStash, '$!mode', PRECISE_SCOPE +| REQUIRE_DYNAMIC);
             nqp::setwho(
                 Metamodel::ModuleHOW.new_type(:name('CALLER')),
                 $stash);
@@ -108,13 +109,19 @@ my class PseudoStash is EnumMap {
         if %pseudoers.exists($key) {
             %pseudoers{$key}(self)
         }
-        elsif $!mode == PRECISE_SCOPE {
+        elsif nqp::bitand_i($!mode, PRECISE_SCOPE) {
             my Mu $store := nqp::getattr(self, EnumMap, '$!storage');
-            nqp::existskey($store, nqp::unbox_s($key)) ??
+            my Mu $res := nqp::existskey($store, nqp::unbox_s($key)) ??
-                nqp::atkey($store, nqp::unbox_s($key)) !!
+                            nqp::atkey($store, nqp::unbox_s($key)) !!
-                Any
+                            Any;
+            if !($res =:= Any) && nqp::bitand_i($!mode, REQUIRE_DYNAMIC) {
+                if !$res.VAR.dynamic {
+                    die "You're trying to access a non-dynamic variable through CALLER.";
+                }
+            }
+            $res;
         }
-        elsif $!mode == DYNAMIC_CHAIN || $!mode == PICK_CHAIN_BY_NAME && substr($key, 1, 1) eq '*' {
+        elsif nqp::bitand_i($!mode, nqp::bitor_i(DYNAMIC_CHAIN, PICK_CHAIN_BY_NAME)) && substr($key, 1, 1) eq '*' {
             my $found := nqp::getlexreldyn(
                 nqp::getattr(self, PseudoStash, '$!ctx'),
                 nqp::unbox_s($key));
@@ -133,11 +140,11 @@ my class PseudoStash is EnumMap {
         if %pseudoers.exists($key) {
             X::Bind.new(target => "pseudo-package $key").throw;
         }
-        elsif $!mode == PRECISE_SCOPE {
+        elsif nqp::bitand_i($!mode, PRECISE_SCOPE) {
             my Mu $store := nqp::getattr(self, EnumMap, '$!storage');
             nqp::bindkey($store, nqp::unbox_s($key), value)
         }
-        elsif $!mode == DYNAMIC_CHAIN || $!mode == PICK_CHAIN_BY_NAME && substr($key, 1, 1) eq '*' {
+        elsif nqp::bitand_i($!mode, nqp::bitor_i(DYNAMIC_CHAIN, PICK_CHAIN_BY_NAME)) && substr($key, 1, 1) eq '*' {
             die "Binding to dynamic variables not yet implemented";
         }
         else {
@@ -150,12 +157,12 @@ my class PseudoStash is EnumMap {
         if %pseudoers.exists($key) {
             True
         }
-        elsif $!mode == PRECISE_SCOPE {
+        elsif nqp::bitand_i($!mode, PRECISE_SCOPE) {
             nqp::p6bool(nqp::existskey(
                 nqp::getattr(self, EnumMap, '$!storage'),
                 nqp::unbox_s($key)))
         }
-        elsif $!mode == DYNAMIC_CHAIN || $!mode == PICK_CHAIN_BY_NAME && substr($key, 1, 1) eq '*' {
+        elsif nqp::bitand_i($!mode, nqp::bitor_i(DYNAMIC_CHAIN, PICK_CHAIN_BY_NAME)) && substr($key, 1, 1) eq '*' {
             nqp::isnull(
                 nqp::getlexreldyn(
                     nqp::getattr(self, PseudoStash, '$!ctx'),

diff --git a/src/core/Scalar.pm b/src/core/Scalar.pm
@@ -12,4 +12,8 @@ my class Scalar {
         my $d := $!descriptor;
         nqp::isnull($d) ?? Mu !! $d.default;
     }
+    method dynamic() {
+        my $d := $!descriptor;
+        nqp::isnull($d) ?? Mu !! $d.dynamic;
+    }
 }
diff --git a/src/core/Variable.pm b/src/core/Variable.pm
@@ -46,9 +46,15 @@ multi trait_mod:<is>(Variable:D $v, :$default!) {
     ).set_default($default);
 }
 multi trait_mod:<is>(Variable:D $v, :$dynamic!) {
-# must be a noop for now, as apparently outer scope lexicals are *always*
+    my $var  := $v.var;
-# visible with the CALLER:: interface, even if they're *not* marked as
+    my $what := $var.VAR.WHAT;
-# "is dynamic"
+    nqp::getattr(
+      $var,
+      $what.perl ~~ m/\+/ # we have types mixed in
+        ?? $what.^mro[1]  # (Hash+{TypedHash}) -> (Hash)
+        !! $what,
+      '$!descriptor',
+    ).set_dynamic($dynamic);
 }
 
 # "of" traits