Only sink if we know about &sink

Doesn't quite work it seems.
rakudo · Feb 16, 2012 · d17935e · d17935e
1 parent 21e7425
commit d17935e
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 5 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -253,7 +253,10 @@ class Perl6::Actions is HLL::Actions {
             );
         }
 
-        $mainline := Perl6::Sinker.sink($mainline);
+        # if &sink isn't in scope, we can't add sink calls either
+        if $*HAS_SINK {
+            $mainline := Perl6::Sinker.sink($mainline);
+        }
 
         # If our caller wants to know the mainline ctx, provide it here.
         # (CTXSAVE is inherited from HLL::Actions.) Don't do this when

diff --git a/src/Perl6/Grammar.pm b/src/Perl6/Grammar.pm
@@ -33,6 +33,8 @@ grammar Perl6::Grammar is HLL::Grammar {
         # XXX Hack: clear any marks.
         pir::set_hll_global__vPsP(['HLL', 'Grammar'], '%!MARKHASH', nqp::null());
 
+        my $*HAS_SINK;
+
         my $cursor := self.comp_unit;
         $*W.pop_lexpad(); # UNIT
         $*W.pop_lexpad(); # UNIT_OUTER
@@ -423,6 +425,7 @@ grammar Perl6::Grammar is HLL::Grammar {
         # CHECK time.
         :my @*CHECK_PHASERS := [];
 
+
         # Setting loading and symbol setup.
         {
             # Create unit outer (where we assemble any lexicals accumulated
@@ -436,6 +439,7 @@ grammar Perl6::Grammar is HLL::Grammar {
             unless pir::defined(%*COMPILING<%?OPTIONS><outer_ctx>) {
                 $*SETTING := $*W.load_setting(%*COMPILING<%?OPTIONS><setting> // 'CORE');
             }
+            $*HAS_SINK := $*W.is_lexical('&sink');
             $/.CURSOR.unitstart();
             try {
                 my $EXPORTHOW := $*W.find_symbol(['EXPORTHOW']);

diff --git a/src/Perl6/Sinker.pm b/src/Perl6/Sinker.pm
@@ -8,13 +8,30 @@ class Perl6::Sinker {
 
     # Called when we encounter a block in the tree.
     method visit_block($block) {
-        self.visit_children($block);
+        $block.blocktype eq 'declaration'
+        ?? $block
+        !! self.visit_children($block);
+    }
+
+    method visit_stmts($st) {
+        my $i := 0;
+        while $i < +@($st) - 1 {
+            $st[$i] := self.visit_children($st[$i]);
+            $i++;
+        }
+        $st;
     }
 
     # Called when we encounter a PAST::Op in the tree. Produces either
     # the op itself or some replacement opcode to put in the tree.
     method visit_op($op) {
-        $op;
+        if  $op.pasttype eq 'call'
+         || $op.pasttype eq 'callmethod'
+         || !$op.pasttype {
+            PAST::Op.new(:name('&sink'), $op);
+        } else {
+            $op;
+        }
     }
 
     # Handles visiting a PAST::Want node.
@@ -40,10 +57,10 @@ class Perl6::Sinker {
                     $node[$i] := self.visit_block($visit);
                 }
                 elsif $visit.isa(PAST::Stmts) {
-                    $node[$i] := self.visit_children($visit);
+                    $node[$i] := self.visit_stmts($visit);
                 }
                 elsif $visit.isa(PAST::Stmt) {
-                    $node[$i] := self.visit_children($visit);
+                    $node[$i] := self.visit_stmts($visit);
                 }
                 elsif $visit.isa(PAST::Want) {
                     $node[$i] := self.visit_want($visit);

diff --git a/src/core/control.pm b/src/core/control.pm
@@ -207,6 +207,8 @@ sub sleep($seconds = $Inf) {         # fractional seconds also allowed
     return $time2 - $time1;
 }
 
+sub sink(|$x) { $x.?sink; Nil }
+
 sub QX($cmd) {
     my Mu $pio := pir::open__Pss(nqp::unbox_s($cmd), 'rp');
     fail "Unable to execute '$cmd'" unless $pio;