sink FIRST and ENTER phasers

rakudo · Jan 7, 2013 · d30d7bc · d30d7bc
1 parent e67fa90
commit d30d7bc
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 42 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -44,38 +44,6 @@ class Perl6::Actions is HLL::Actions does STDActions {
         $STATEMENT_PRINT := 0;
     }
 
-    sub sink($past) {
-        my $name := $past.unique('sink');
-        QAST::Want.new(
-            $past,
-            'v',
-            QAST::Stmts.new(
-                QAST::Op.new(:op<bind>,
-                    QAST::Var.new(:$name, :scope<local>, :decl<var>),
-                    $past,
-                ),
-                QAST::Op.new(:op<if>,
-                    QAST::Op.new(:op<if>,
-                        QAST::Op.new(:op<isconcrete>,
-                            QAST::Var.new(:$name, :scope<local>),
-                        ),
-                        QAST::Op.new(:op<if>,
-                            QAST::Op.new(:op<can>,
-                                QAST::Var.new(:$name, :scope<local>),
-                                QAST::SVal.new(:value('sink')),
-                            ),
-                            QAST::Op.new(:op<defined>,
-                                QAST::Var.new(:$name, :scope<local>),
-                            )
-                        )
-                    ),
-                    QAST::Op.new(:op<callmethod>, :name<sink>,
-                        QAST::Var.new(:$name, :scope<local>),
-                    ),
-                ),
-            ),
-        );
-    }
     my %sinkable := nqp::hash(
             'call',         1,
             'callmethod',   1,
@@ -89,7 +57,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
     );
     sub autosink($past) {
         nqp::istype($past, QAST::Op) && %sinkable{$past.op} && !$past<nosink>
-            ?? sink($past)
+            ?? $*W.sink($past)
             !! $past;
     }
 
@@ -5279,7 +5247,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
         if $handler<past_block><handlers> && nqp::existskey($handler<past_block><handlers>, 'SUCCEED') {
             my $suc := $handler<past_block><handlers><SUCCEED>;
             $suc[0] := QAST::Stmts.new(
-                sink(QAST::Op.new(
+                $*W.sink(QAST::Op.new(
                     :op('getpayload'),
                     QAST::Op.new( :op('exception') )
                 )),

diff --git a/src/Perl6/World.pm b/src/Perl6/World.pm
@@ -857,9 +857,57 @@ class Perl6::World is HLL::World {
         );
         self.add_fixup_task(:fixup_past($fixups), :deserialize_past($fixups));
     }
+
+    # put an expression in sink context
+    method past_sink($past) {
+        my $name := $past.unique('sink');
+        QAST::Stmts.new(
+            QAST::Op.new(:op<bind>,
+                QAST::Var.new(:$name, :scope<local>, :decl<var>),
+                $past,
+            ),
+            QAST::Op.new(:op<if>,
+                QAST::Op.new(:op<if>,
+                    QAST::Op.new(:op<isconcrete>,
+                        QAST::Var.new(:$name, :scope<local>),
+                    ),
+                    QAST::Op.new(:op<if>,
+                        QAST::Op.new(:op<can>,
+                            QAST::Var.new(:$name, :scope<local>),
+                            QAST::SVal.new(:value('sink')),
+                        ),
+                        QAST::Op.new(:op<defined>,
+                            QAST::Var.new(:$name, :scope<local>),
+                        )
+                    )
+                ),
+                QAST::Op.new(:op<callmethod>, :name<sink>,
+                    QAST::Var.new(:$name, :scope<local>),
+                ),
+            ),
+        );
+    }
+
+    # put an expression into potential sink context
+    method sink($past) {
+        my $name := $past.unique('sink');
+        QAST::Want.new(
+            $past,
+            'v',
+            self.past_sink($past)
+        );
+    }
+
 
     # Generates code for running phasers.
-    method run_phasers_code($code, $block_type, $type) {
+    method run_phasers_code($code, $block_type, $type, :$sink) {
+        my $call := QAST::Op.new(
+            :op('call'),
+            QAST::Var.new( :scope('lexical'), :name('$_'), :decl('param') )
+        );
+        if $sink {
+            $call := self.past_sink($call);
+        }
         QAST::Op.new(
             :op('for'),
             QAST::Op.new(
@@ -872,11 +920,10 @@ class Perl6::World is HLL::World {
                 QAST::SVal.new( :value($type) )
             ),
             QAST::Block.new(
-                :blocktype('immediate'),
-                QAST::Op.new(
-                    :op('call'),
-                    QAST::Var.new( :scope('lexical'), :name('$_'), :decl('param') )
-                )))
+                :blocktype('immediate'), 
+                $call
+            )
+        )
     }
 
     # Adds any extra code needing for handling phasers.
@@ -893,10 +940,10 @@ class Perl6::World is HLL::World {
                 $code_past[0].push(QAST::Op.new(
                     :op('if'),
                     QAST::Op.new( :op('p6takefirstflag') ),
-                    self.run_phasers_code($code, $block_type, 'FIRST')));
+                    self.run_phasers_code($code, $block_type, 'FIRST', :sink)));
             }
             if nqp::existskey(%phasers, 'ENTER') {
-                $code_past[0].push(self.run_phasers_code($code, $block_type, 'ENTER'));
+                $code_past[0].push(self.run_phasers_code($code, $block_type, 'ENTER', :sink));
             }
             if nqp::existskey(%phasers, '!LEAVE-ORDER') || nqp::existskey(%phasers, 'POST') {
                 $code_past[+@($code_past) - 1] := QAST::Op.new(