knowhow declarations using the new meta-model now work.

perl6 · Sep 25, 2010 · 9937ece · 9937ece
1 parent 5a6ffa4
commit 9937ece
Show file tree

Hide file tree

Showing 2 changed files with 50 additions and 19 deletions.
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
@@ -413,9 +413,9 @@ sub package($/) {
     # Run this at loadinit time.
     @BLOCK[0].loadinit.push(PAST::Block.new( :blocktype('immediate'), $*PACKAGE-SETUP ));
 
-    # Set up lexical for this to live in.
-    @BLOCK[0][0].unshift(PAST::Var.new( :name($name), :scope('lexical'), :isdecl(1) ));
-    @BLOCK[0].symbol($name, :scope('lexical'));
+    # Set up variable for this to live in.
+    @BLOCK[0][0].unshift(PAST::Var.new( :name($name), :scope('package'), :isdecl(1) ));
+    @BLOCK[0].symbol($name, :scope('package'));
 
     # Just evaluate anything else in the package in-line.
     my $past := $<package_def>.ast;
@@ -529,21 +529,53 @@ method routine_def($/) {
 
 
 method method_def($/) {
-    my $past := $<blockoid>.ast;
-    $past.blocktype('method');
-    if $*SCOPE eq 'our' {
-        $past.pirflags(':nsentry');
-    }
-    $past.control('return_pir');
-    $past[0].unshift( PAST::Op.new( :inline('    .lex "self", self') ) );
-    $past.symbol('self', :scope('lexical') );
-    if $<deflongname> {
-        my $name := ~$<deflongname>[0].ast;
-        $past.name($name);
+    if $*PACKAGE-SETUP {
+        # Set up block including adding self (invocant) parameter.
+        my $past := $<blockoid>.ast;
+        $past.control('return_pir');
+        $past[0].unshift( PAST::Var.new( :name('self'), :scope('parameter') ) );
+        $past.symbol('self', :scope('lexical') );
+
+        # Install it where it should go (methods table / namespace).
+        if $<deflongname> {
+            my $name := ~$<deflongname>[0].ast;
+            $past.name($name);
+            $*PACKAGE-SETUP.push(PAST::Op.new(
+                :pasttype('callmethod'), :name($*MULTINESS eq 'multi' ?? 'add_multi_method' !! 'add_method'),
+                PAST::Op.new(
+                    # XXX Should be nqpop at some point.
+                    :pirop('get_how PP'),
+                    PAST::Var.new( :name('type_obj'), :scope('register') )
+                ),
+                PAST::Var.new( :name('type_obj'), :scope('register') ),
+                PAST::Val.new( :value($name) ),
+                PAST::Val.new( :value($past) )
+            ));
+        }
+        if $*SCOPE eq 'our' {
+            $past.pirflags(':nsentry');
+        }
+
+        $past<block_past> := $past;
+        make $past;
+    }
+    else {
+        my $past := $<blockoid>.ast;
+        $past.blocktype('method');
+        if $*SCOPE eq 'our' {
+            $past.pirflags(':nsentry');
+        }
+        $past.control('return_pir');
+        $past[0].unshift( PAST::Op.new( :inline('    .lex "self", self') ) );
+        $past.symbol('self', :scope('lexical') );
+        if $<deflongname> {
+            my $name := ~$<deflongname>[0].ast;
+            $past.name($name);
+        }
+        if $*MULTINESS eq 'multi' { $past.multi().unshift('_'); }
+        $past<block_past> := $past;
+        make $past;
     }
-    if $*MULTINESS eq 'multi' { $past.multi().unshift('_'); }
-    $past<block_past> := $past;
-    make $past;
     if $<trait> {
         for $<trait> { $_.ast()($/); }
     }

diff --git a/src/NQP/Grammar.pm b/src/NQP/Grammar.pm
@@ -22,6 +22,7 @@ method TOP() {
 
     my $*SCOPE      := '';
     my $*MULTINESS  := '';
+    my $*PACKAGE-SETUP;
     self.comp_unit;
 }
 
@@ -277,12 +278,10 @@ token package_declarator:sym<knowhow> {
     <sym> <package_def>
 }
 token package_declarator:sym<class> {
-    :my $*PACKAGE-SETUP := PAST::Stmts.new();
     :my $*PKGDECL := 'class';
     <sym> <package_def>
 }
 token package_declarator:sym<grammar> {
-    :my $*PACKAGE-SETUP := PAST::Stmts.new();
     :my $*PKGDECL := 'grammar';
     <sym> <package_def>
 }