p6for desugar op

Move some <for> logic into a desugar op for easier handling by the optimizer.
rakudo · Oct 17, 2015 · 033427b · 033427b
1 parent 68563f4
commit 033427b
Showing 1 changed file with 51 additions and 36 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -5,6 +5,17 @@ use Perl6::Ops;
 use QRegex;
 use QAST;
 
+sub block_closure($code) {
+    my $closure := QAST::Op.new(
+        :op('callmethod'), :name('clone'),
+        $code
+    );
+    $closure := QAST::Op.new( :op('p6capturelex'), $closure);
+    $closure.annotate('past_block', $code.ann('past_block'));
+    $closure.annotate('code_object', $code.ann('code_object'));
+    $closure
+}
+
 register_op_desugar('p6callmethodhow', -> $qast {
     $qast   := $qast.shallow_clone();
     my $inv := $qast.shift;
@@ -46,6 +57,31 @@ register_op_desugar('p6fatalize', -> $qast {
             )
         ))
 });
+register_op_desugar('p6for', -> $qast {
+    my $xblock := $qast[0];
+    my $label := $qast[1];
+    my $for-list-name := QAST::Node.unique('for-list');
+    my $iscont := QAST::Op.new(:op('iscont'), QAST::Var.new( :name($for-list-name), :scope('local') ));
+    $iscont.named('item');
+    my $call := QAST::Op.new(
+        :op<callmethod>, :name<map>, :node($qast),
+        QAST::Var.new( :name($for-list-name), :scope('local') ),
+        block_closure($xblock[1]),
+        $iscont,
+    );
+    if $label {
+        $call.push($label);
+    }
+    my $bind := QAST::Op.new(
+        :op('bind'),
+        QAST::Var.new( :name($for-list-name), :scope('local'), :decl('var') ),
+        $xblock[0],
+    );
+    QAST::Stmts.new(
+        $bind,
+        QAST::Op.new( :op<callmethod>, :name($qast.ann('context')), $call )
+    );
+});
 
 role STDActions {
     method quibble($/) {
@@ -1240,35 +1276,25 @@ Compilation unit '$file' contained the following violations:
 
     method statement_control:sym<for>($/) {
         my $xblock := $<xblock>.ast;
-        my $for-list-name := QAST::Node.unique('for-list');
-        my $iscont := QAST::Op.new(:op('iscont'), QAST::Var.new( :name($for-list-name), :scope('local') ));
-        $iscont.named('item');
-        my $call := QAST::Op.new(
-            :op<callmethod>, :name<map>, :node($/),
-            QAST::Var.new( :name($for-list-name), :scope('local') ),
-            block_closure($xblock[1]),
-            $iscont,
-        );
-        if $*LABEL {
-            $call.push(QAST::WVal.new( :value($*W.find_symbol([$*LABEL])), :named('label') ));
-        }
-        my $bind := QAST::Op.new(
-            :op('bind'),
-            QAST::Var.new( :name($for-list-name), :scope('local'), :decl('var') ),
-            $xblock[0],
-        );
         my $past := QAST::Want.new(
-            QAST::Stmts.new(
-                $bind,
-                QAST::Op.new( :op<callmethod>, :name<eager>, $call )
+            QAST::Op.new(
+                :op<p6for>, :node($/),
+                $xblock,
             ),
-            'v', QAST::Stmts.new(
-                $bind,
-                QAST::Op.new( :op<callmethod>, :name<sink>, $call )
+            'v', QAST::Op.new(
+                :op<p6for>, :node($/),
+                $xblock,
             ),
         );
-        my $sinkee := $past[0][1];
-        $past.annotate('statement_level', -> { $sinkee.name('sink') });
+        if $*LABEL {
+            my $label := QAST::WVal.new( :value($*W.find_symbol([$*LABEL])), :named('label') );
+            $past[0].push($label);
+            $past[2].push($label);
+        }
+        $past[0].annotate('context', 'eager');
+        $past[2].annotate('context', 'sink');
+        my $sinkee := $past[0];
+        $past.annotate('statement_level', -> { $sinkee.annotate('context', 'sink') });
         make $past;
     }
 
@@ -7591,17 +7617,6 @@ Compilation unit '$file' contained the following violations:
         $ref
     }
 
-    sub block_closure($code) {
-        my $closure := QAST::Op.new(
-            :op('callmethod'), :name('clone'),
-            $code
-        );
-        $closure := QAST::Op.new( :op('p6capturelex'), $closure);
-        $closure.annotate('past_block', $code.ann('past_block'));
-        $closure.annotate('code_object', $code.ann('code_object'));
-        $closure
-    }
-
     sub make_thunk_ref($to_thunk, $/) {
         my $block := $*W.push_lexpad($/);
         fatalize($to_thunk) if %*PRAGMAS<fatal>;