Further clean up term:sym<name>, so we don't do any of the reparsing …

…and don't rebuild the LongName object. Since we encounter this rule a fair amount, this seems to improve compilation performance a little.
rakudo · Apr 14, 2012 · b82d905 · b82d905
1 parent c59411c
commit b82d905
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 13 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -3148,18 +3148,17 @@ class Perl6::Actions is HLL::Actions {
 
     method term:sym<name>($/) {
         my $past;
-        my $longname := $*W.disect_longname($<longname>);
-        if $longname.contains_indirect_lookup() {
+        if $*longname.contains_indirect_lookup() {
             if $<args> {
                 $/.CURSOR.panic("Combination of indirect name lookup and call not (yet?) allowed");
             }
-            $past := self.make_indirect_lookup($longname.components())
+            $past := self.make_indirect_lookup($*longname.components())
         }
         elsif $<args> {
             # If we have args, it's a call. Look it up dynamically
             # and make the call.
             # Add & to name.
-            my @name := Perl6::Grammar::parse_name(~$<longname>);
+            my @name := nqp::clone($*longname.components());
             my $final := @name[+@name - 1];
             if pir::substr($final, 0, 1) ne '&' {
                 @name[+@name - 1] := '&' ~ $final;
@@ -3221,7 +3220,7 @@ class Perl6::Actions is HLL::Actions {
         else {
             # Otherwise, it's a type name; build a reference to that
             # type, since we can statically resolve them.
-            my @name := $longname.type_name_parts('type name');
+            my @name := $*longname.type_name_parts('type name');
             if $<arglist> {
                 # Look up parametric type.
                 my $ptype := $*W.find_symbol(@name);
@@ -3256,7 +3255,7 @@ class Perl6::Actions is HLL::Actions {
             }
 
             # Names ending in :: really want .WHO.
-            if $longname.get_who {
+            if $*longname.get_who {
                 $past := PAST::Op.new( :pirop('get_who PP'), $past );
             }
         }

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1928,13 +1928,13 @@ grammar Perl6::Grammar is HLL::Grammar {
 
     token term:sym<name> {
         <longname>
-        :my @longname;
-        { @longname := parse_name($<longname>.Str) }
+        :my $*longname;
+        { $*longname := $*W.disect_longname($<longname>) }
         [
-        ||  <?{ pir::substr($<longname>.Str, 0, 2) eq '::' || $*W.is_name(@longname) }>
+        ||  <?{ pir::substr($<longname>.Str, 0, 2) eq '::' || $*W.is_name($*longname.components()) }>
             <.unsp>?
             [
-                <?{ $*W.is_type(@longname) }>
+                <?{ $*W.is_type($*longname.components()) }>
                 <?before '['> '[' ~ ']' <arglist>
             ]?
         || <args>

diff --git a/src/Perl6/World.pm b/src/Perl6/World.pm
@@ -1388,7 +1388,7 @@ class Perl6::World is HLL::World {
         method get_who() {
             $!get_who
         }
-        
+
         # Checks if a name component is a pseudo-package.
         sub is_pseudo_package($comp) {
             $comp eq 'CORE' || $comp eq 'SETTING' || $comp eq 'UNIT' ||
@@ -1429,8 +1429,30 @@ class Perl6::World is HLL::World {
         }
         nqp::bindattr($result, LongName, '@!components', @components);
 
-        # Stash colon pairs.
-        nqp::bindattr($result, LongName, '@!colonpairs', $name<colonpair>);
+        # Stash colon pairs with names; incorporate non-named one into
+        # the last part of the name (e.g. for infix:<+>). Need to be a
+        # little cheaty when compiling the setting due to bootstrapping.
+        my @pairs;
+        if pir::isa($longname<colonpair>, 'ResizablePMCArray') {
+            for $longname<colonpair> {
+                if $_<circumfix> && !$_<identifier> {
+                    my $value := $_.ast;
+                    if $value<has_compile_time_value> {
+                        @components[+@components - 1] := @components[+@components - 1] ~
+                            (%*COMPILING<%?OPTIONS><setting> ne 'NULL' ??
+                            ':<' ~ ~$value<compile_time_value> ~ '>' !!
+                            ~$_);
+                    }
+                    else {
+                        pir::die(~$_ ~ ' cannot be resolved at compile time');
+                    }
+                }
+                else {
+                    @pairs.push($_);
+                }
+            }
+        }
+        nqp::bindattr($result, LongName, '@!colonpairs', @pairs);
 
         $result
     }