Switch indirect name lookups to use the new root PseudoStash approach…

…. Still much missing in PseudoStash to make that work yet, mind. Also a little more elimination of duplicate logic.
rakudo · Apr 14, 2012 · 68df8f5 · 68df8f5
1 parent 1c862bc
commit 68df8f5
Show file tree

Hide file tree

Showing 3 changed files with 39 additions and 38 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1090,12 +1090,18 @@ class Perl6::Actions is HLL::Actions {
                                            'item');
         }
         else {
-            if $<desigilname> && $<desigilname><longname> && self.is_indirect_lookup($<desigilname><longname>) {
-                if $*IN_DECL {
-                    $*W.throw($/, ['X', 'Syntax', 'Variable', 'IndirectDeclaration']);
+            my $indirect;
+            if $<desigilname> && $<desigilname><longname> {
+                my $longname := $*W.disect_longname($<desigilname><longname>);
+                if $longname.contains_indirect_lookup() {
+                    if $*IN_DECL {
+                        $*W.throw($/, ['X', 'Syntax', 'Variable', 'IndirectDeclaration']);
+                    }
+                    $past := self.make_indirect_lookup($longname.components(), ~$<sigil>);
+                    $indirect := 1;
                 }
-                $past := self.make_indirect_lookup($<desigilname><longname>, ~$<sigil>);
-            } else {
+            }
+            unless $indirect {
                 $past := make_variable($/, ~$/);
             }
         }
@@ -3120,29 +3126,21 @@ class Perl6::Actions is HLL::Actions {
         }
     }
 
-    method is_indirect_lookup($longname) {
-        for $longname<name><morename> {
-            if $_<EXPR> {
-                return 1;
-            }
-        }
-        0;
-    }
-
-    method make_indirect_lookup($longname, $sigil?) {
+    method make_indirect_lookup(@components, $sigil?) {
         my $past := PAST::Op.new(
             :pasttype<call>,
             :name<&INDIRECT_NAME_LOOKUP>,
+            PAST::Op.new(
+                :pasttype<callmethod>, :name<new>,
+                $*W.get_ref($*W.find_symbol(['PseudoStash']))
+            )
         );
         $past.push($*W.add_string_constant($sigil)) if $sigil;
-        $past.push($*W.add_string_constant(~$longname<name><identifier>))
-            if $longname<name><identifier>;
-
-        for $longname<name><morename> {
-            if $_<EXPR> {
-                $past.push($_<EXPR>[0].ast);
+        for @components {
+            if pir::can($_, 'isa') && $_.isa(PAST::Node) {
+                $past.push($_);
             } else {
-                $past.push($*W.add_string_constant(~$_<identifier>));
+                $past.push($*W.add_string_constant(~$_));
             }
         }
         $past;
@@ -3155,7 +3153,7 @@ class Perl6::Actions is HLL::Actions {
             if $<args> {
                 $/.CURSOR.panic("Combination of indirect name lookup and call not (yet?) allowed");
             }
-            $past := self.make_indirect_lookup($<longname>)
+            $past := self.make_indirect_lookup($longname.components())
         }
         elsif $<args> {
             # If we have args, it's a call. Look it up dynamically

diff --git a/src/Perl6/World.pm b/src/Perl6/World.pm
@@ -1329,6 +1329,12 @@ class Perl6::World is HLL::World {
             pir::join('::', @parts)
         }
 
+        # Gets the individual components, which may be PAST nodes for
+        # unknown pieces.
+        method components() {
+            @!components
+        }
+
         # Checks if there is an indirect lookup required.
         method contains_indirect_lookup() {
             for @!components {
@@ -1349,7 +1355,14 @@ class Perl6::World is HLL::World {
             }
             for @!components {
                 if pir::can($_, 'isa') && $_.isa(PAST::Node) {
-                    pir::die("Name $!text is not compile-time known, and can not serve as a $dba");
+                    if $_<has_compile_time_value> {
+                        for nqp::split('::', ~$_<compile_time_value>) {
+                            @name.push($_);
+                        }
+                    }
+                    else {
+                        pir::die("Name $!text is not compile-time known, and can not serve as a $dba");
+                    }
                 }
                 elsif $beyond_pp || !is_pseudo_package($_) {
                     nqp::push(@name, $_);
@@ -1404,14 +1417,7 @@ class Perl6::World is HLL::World {
             }
             elsif $_<EXPR> {
                 my $EXPR := $_<EXPR>[0].ast;
-                if $EXPR<has_compile_time_value> {
-                    for nqp::split('::', ~$EXPR<compile_time_value>) {
-                        @components.push($_);
-                    }
-                }
-                else {
-                    @components.push($EXPR);
-                }
+                @components.push($EXPR);
             }
             else {
                 # Either it's :: as a name entirely, in which case it's anon,

diff --git a/src/core/operators.pm b/src/core/operators.pm
@@ -213,7 +213,7 @@ sub infix:<^ff^>($a as Bool, $b as Bool) {
 
 # not sure where this should go
 # this implements the ::() indirect lookup
-sub INDIRECT_NAME_LOOKUP(*@chunks) is rw {
+sub INDIRECT_NAME_LOOKUP($root, *@chunks) is rw {
     # note that each part of @chunks itself can
     # contain double colons. That's why joining and
     # re-splitting is necessary
@@ -231,11 +231,8 @@ sub INDIRECT_NAME_LOOKUP(*@chunks) is rw {
             $name = @chunks.join('::');
         }
     }
-    my Mu $thing := pir::find_caller_lex__Ps(
-        nqp::unbox_s($first)
-    );
-    $thing := GLOBAL.WHO{$first} if nqp::isnull($thing) && nqp::existskey(GLOBAL.WHO, $first);
-    fail("Symbol '$name' not found") if nqp::isnull($thing);
+    fail("Symbol '$name' not found") unless $root.exists($first);
+    my Mu $thing := $root{$first};
     for @parts {
         fail("Symbol '$name not found") unless $thing.WHO.exists($_);
         $thing := $thing.WHO{$_};