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

[jonathan]

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;
 }