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

[svn:parrot] r35216 - in branches/rvar2/languages/perl6/src: builtins parser

From:
jonathan
Date:
January 8, 2009 10:17
Subject:
[svn:parrot] r35216 - in branches/rvar2/languages/perl6/src: builtins parser
Message ID:
20090108181727.60AA8CB9F9@x12.develooper.com
Author: jonathan
Date: Thu Jan  8 10:17:26 2009
New Revision: 35216

Modified:
   branches/rvar2/languages/perl6/src/builtins/guts.pir
   branches/rvar2/languages/perl6/src/parser/actions.pm

Log:
[rakudo] Mostly fix anonymous classes; only problem now is that .WHAT doesn't hand back the empty string, but should be easily fixable. 9/10 tests pass.

Modified: branches/rvar2/languages/perl6/src/builtins/guts.pir
==============================================================================
--- branches/rvar2/languages/perl6/src/builtins/guts.pir	(original)
+++ branches/rvar2/languages/perl6/src/builtins/guts.pir	Thu Jan  8 10:17:26 2009
@@ -446,7 +446,7 @@
     if $P0 != 'grammar' goto register
     $S0 = 'Grammar'
   register:
-    p6meta.'register'(metaclass, 'parent'=>$S0)
+    .tailcall p6meta.'register'(metaclass, 'parent'=>$S0)
   no_pkgtype:
 .end
 

Modified: branches/rvar2/languages/perl6/src/parser/actions.pm
==============================================================================
--- branches/rvar2/languages/perl6/src/parser/actions.pm	(original)
+++ branches/rvar2/languages/perl6/src/parser/actions.pm	Thu Jan  8 10:17:26 2009
@@ -1394,8 +1394,23 @@
     );
 
     #  ...and at the end of the block's initializer (after any other
-    #  items added by the block), we finalize the composition
-    $block[0].push( PAST::Op.new( :name('!meta_compose'), $?METACLASS) );
+    #  items added by the block), we finalize the composition. This
+    # returns a proto, which we need to keep around and also return at
+    # the end of initialization for anonymous classes.
+    if $<module_name> eq "" && ($?PKGDECL eq 'class' || $?PKGDECL eq 'role'
+            || $?PKGDECL eq 'grammar') {
+        $block[0].push(PAST::Op.new(
+            :pasttype('bind'),
+            PAST::Var.new(:name('proto_store'), :scope('register'), :isdecl(1)),
+            PAST::Op.new( :name('!meta_compose'), $?METACLASS)
+        ));
+        $block.push(PAST::Var.new(:name('proto_store'), :scope('register')));
+        $block.blocktype('immediate');
+        $block.pirflags('');
+    }
+    else {
+        $block[0].push( PAST::Op.new( :name('!meta_compose'), $?METACLASS) );
+    }
 
     make $block;
 }



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