[Yapsi] added ENTER phaser

And it works! Not bad.
masak · May 1, 2011 · a7d23db · a7d23db
1 parent 79609ac
commit a7d23db
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 6 deletions.
diff --git a/lib/Yapsi.pm b/lib/Yapsi.pm
@@ -43,9 +43,10 @@ grammar Yapsi::Perl6::Grammar {
     rule  statement_control_until { 'until' <expression> <block> }
 
     token expression { <assignment> || <binding> || <variable> || <literal>
-                       || <declaration> || <invocation> || <block>
+                       || <declaration> || <invocation> || <block> || <phaser>
                        || <saycall> || <subcall> || <increment> || <decrement>
                      }
+    rule phaser { 'ENTER' <block> }
     token lvalue { <declaration> || <variable> || <increment> }
     token value { <variable> || <literal> || <declaration> || <saycall>
                   || <increment> }
@@ -104,6 +105,7 @@ class FUTURE::Block is FUTURE::Node {
     has $.name;
     has @.vars is rw;
     has $.immediate is rw;
+    has $.phaser is rw;
 
     method info { [~] ' -- ', $.name,
                       (' [', @.vars»<name>.join(', '), ']' if @.vars) }
@@ -246,7 +248,12 @@ class Yapsi::Perl6::Actions {
 
     method expression($/) {
         hoist $/, <assignment literal saycall subcall variable declaration
-                   binding increment decrement invocation block>;
+                   binding increment decrement invocation block phaser>;
+    }
+
+    method phaser($/) {
+        hoist $/, ('block', );
+        $/.ast.phaser = True;
     }
 
     method lvalue($/) {
@@ -501,10 +508,17 @@ class Yapsi::Compiler {
             $register = unique-register;
             push @blocks-to-serialize, $block
                 unless any(@already-serialized) eq $block;
-            push @blocksic,
-                "$register = closure-from-block '$block.name()'";
-            if $block.immediate {
-                push @blocksic, "call $register";
+            if $block.phaser {
+                unshift @blocksic,
+                    "$register = closure-from-block '$block.name()'",
+                    "call $register";
+            }
+            else {
+                push @blocksic,
+                    "$register = closure-from-block '$block.name()'";
+                if $block.immediate {
+                    push @blocksic, "call $register";
+                }
             }
         }
 

diff --git a/t/compiler.t b/t/compiler.t
@@ -43,6 +43,7 @@ my @programs-that-compile =
     'our sub foo {}',
     'sub foo {}; foo',
     'sub foo {}; foo()',
+    'say 2; ENTER { say 1 }'
 ;
 
 sub escape($string) { $string.subst("\n", "\\n", :g) }

diff --git a/t/runtime.t b/t/runtime.t
@@ -55,6 +55,7 @@ my @tests =
     'foo(); sub foo { say 5 }',        "5\n",       'call before declaration',
     'sub foo { bar; sub bar { say 42 } }; foo',
                                        "42\n",      'nested sub call',
+    'say 2; ENTER { say 1 }; say 3',   "1\n2\n3\n", 'ENTER phaser',
 ;
 
 for @tests -> $program, $expected, $message {