develooper Front page | perl.cvs.parrot | Postings from January 2009

[svn:parrot] r35447 - trunk/languages/perl6/src/parser

From:
jonathan
Date:
January 12, 2009 10:16
Subject:
[svn:parrot] r35447 - trunk/languages/perl6/src/parser
Message ID:
20090112181627.B7681CB9F9@x12.develooper.com
Author: jonathan
Date: Mon Jan 12 10:16:27 2009
New Revision: 35447

Modified:
   trunk/languages/perl6/src/parser/actions.pm

Log:
[rakudo] The term action was emitting sub calls incorrectly (not doing namespace lookups), however we didn't notice in a couple of tests because of the typename hack. The type registry picks this up. This patch is from rakudoreg branch, with updates to follow other changes to this action method.

Modified: trunk/languages/perl6/src/parser/actions.pm
==============================================================================
--- trunk/languages/perl6/src/parser/actions.pm	(original)
+++ trunk/languages/perl6/src/parser/actions.pm	Mon Jan 12 10:16:27 2009
@@ -2081,24 +2081,60 @@
 
 
 method term($/, $key) {
-    my $name := ~$<name>;
     my $past;
+
+    my @ns;
+    my $short_name;
+    if $<name> {
+        @ns := Perl6::Compiler.parse_name(~$<name>);
+        $short_name := @ns.pop();
+    }
+
     if $key eq 'noarg' {
-        if $name eq 'print' || $name eq 'say' {
-            $/.panic($name ~ ' requires an argument');
+        if @ns {
+            $past := PAST::Op.new(
+                PAST::Var.new(
+                    :name($short_name),
+                    :namespace(@ns),
+                    :scope('package')
+                ),
+                :pasttype('call')
+            );
+        }
+        else {
+            if $short_name eq 'print' || $short_name eq 'say' {
+                $/.panic($short_name ~ ' requires an argument');
+            }
+            $past := PAST::Op.new( :name( $short_name ), :pasttype('call') );
         }
-        $past := PAST::Op.new( :name( ~$<name> ), :pasttype('call') );
     }
     elsif $key eq 'args' {
         $past := $($<args>);
-        $past.name( $name );
-        if +@($past) == 0 && ($name eq 'print' || $name eq 'say') {
-            $/.panic($name ~ ' requires an argument');
+        if @ns {
+            $past.unshift(PAST::Var.new(
+                :name($short_name),
+                :namespace(@ns),
+                :scope('package')
+            ));
+        } else {
+            if +@($past) == 0 && ($short_name eq 'print' || $short_name eq 'say') {
+                $/.panic($short_name ~ ' requires an argument');
+            }
+            $past.name( $short_name );
         }
     }
     elsif $key eq 'func args' {
         $past := build_call( $( $<semilist> ) );
-        $past.name( $name );
+        if @ns {
+            $past.unshift(PAST::Var.new(
+                :name($short_name),
+                :namespace(@ns),
+                :scope('package')
+            ));
+        }
+        else {
+            $past.name( $short_name );
+        }
     }
     elsif $key eq 'VAR' {
         $past := PAST::Op.new(



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About