Get onlystar handling in place a little more, with a call into the (d…

…o be set up) multi-dispatcher.
rakudo · May 30, 2011 · bf1066c · bf1066c
1 parent 9042f2d
commit bf1066c
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 4 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -1082,8 +1082,9 @@ class Perl6::Actions is HLL::Actions {
 
     method routine_def($/) {
         my $block;
+
         if $<onlystar> {
-            $block := onlystar_block();
+            $block := $<onlystar>.ast;
         }
         else {
             $block := $<blockoid>.ast;
@@ -1136,14 +1137,15 @@ class Perl6::Actions is HLL::Actions {
         else {
             $past := create_closure($code);
         }
+
         make $past;
     }
 
 
     method method_def($/) {
         my $past;
         if $<onlystar> {
-            $past := onlystar_block();
+            $past := $<onlystar>.ast;
         }
         else {
             $past := $<blockoid>.ast;
@@ -1167,6 +1169,11 @@ class Perl6::Actions is HLL::Actions {
         # Create code object.
         my $type := $*METHODTYPE eq 'submethod' ?? 'Submethod' !! 'Method';
         my $code := $*ST.create_code_object($past, $type, $signature);
+
+        # If we're a multi-dispatch entry point, add code object reference.
+        if $past<multi_enterer> {
+            $past.push($*ST.get_object_sc_ref_past($code));
+        }
 
         # Install method.
         if $<longname> {
@@ -1199,8 +1206,13 @@ class Perl6::Actions is HLL::Actions {
         make $past;
     }
 
-    sub onlystar_block() {
-        make PAST::Op.new( :pirop('die vS'), 'multi-dispatch not yet implemented');
+    method onlystar($/) {
+        my $BLOCK := $*CURPAD;
+        my $enterer := PAST::Op.new( :pirop('perl6_enter_multi_dispatch PP') );
+        $BLOCK<multi_enterer> := $enterer;
+        $BLOCK.push($enterer);
+        $BLOCK.node($/);
+        make $BLOCK;
     }
 
     sub install_method($/, $code, $name, %table) {

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -1124,10 +1124,12 @@ grammar Perl6::Grammar is HLL::Grammar {
     }
 
     token onlystar {
+        :my $*CURPAD;
         <?{ $*MULTINESS eq 'proto' }>
         '{' <.ws> '*' <.ws> '}'
         <?ENDSTMT>
         <.finishpad>
+        { $*CURPAD := $*ST.pop_lexpad() }
     }
 
     ###########################