Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

sink FIRST and ENTER phasers

  • Loading branch information...
commit d30d7bc1d4932f07e16538a2abb90b8501020e92 1 parent e67fa90
Moritz Lenz moritz authored

Showing 2 changed files with 57 additions and 42 deletions. Show diff stats Hide diff stats

  1. +2 34 src/Perl6/Actions.pm
  2. +55 8 src/Perl6/World.pm
36 src/Perl6/Actions.pm
@@ -44,38 +44,6 @@ class Perl6::Actions is HLL::Actions does STDActions {
44 44 $STATEMENT_PRINT := 0;
45 45 }
46 46
47   - sub sink($past) {
48   - my $name := $past.unique('sink');
49   - QAST::Want.new(
50   - $past,
51   - 'v',
52   - QAST::Stmts.new(
53   - QAST::Op.new(:op<bind>,
54   - QAST::Var.new(:$name, :scope<local>, :decl<var>),
55   - $past,
56   - ),
57   - QAST::Op.new(:op<if>,
58   - QAST::Op.new(:op<if>,
59   - QAST::Op.new(:op<isconcrete>,
60   - QAST::Var.new(:$name, :scope<local>),
61   - ),
62   - QAST::Op.new(:op<if>,
63   - QAST::Op.new(:op<can>,
64   - QAST::Var.new(:$name, :scope<local>),
65   - QAST::SVal.new(:value('sink')),
66   - ),
67   - QAST::Op.new(:op<defined>,
68   - QAST::Var.new(:$name, :scope<local>),
69   - )
70   - )
71   - ),
72   - QAST::Op.new(:op<callmethod>, :name<sink>,
73   - QAST::Var.new(:$name, :scope<local>),
74   - ),
75   - ),
76   - ),
77   - );
78   - }
79 47 my %sinkable := nqp::hash(
80 48 'call', 1,
81 49 'callmethod', 1,
@@ -89,7 +57,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
89 57 );
90 58 sub autosink($past) {
91 59 nqp::istype($past, QAST::Op) && %sinkable{$past.op} && !$past<nosink>
92   - ?? sink($past)
  60 + ?? $*W.sink($past)
93 61 !! $past;
94 62 }
95 63
@@ -5279,7 +5247,7 @@ class Perl6::Actions is HLL::Actions does STDActions {
5279 5247 if $handler<past_block><handlers> && nqp::existskey($handler<past_block><handlers>, 'SUCCEED') {
5280 5248 my $suc := $handler<past_block><handlers><SUCCEED>;
5281 5249 $suc[0] := QAST::Stmts.new(
5282   - sink(QAST::Op.new(
  5250 + $*W.sink(QAST::Op.new(
5283 5251 :op('getpayload'),
5284 5252 QAST::Op.new( :op('exception') )
5285 5253 )),
63 src/Perl6/World.pm
@@ -857,9 +857,57 @@ class Perl6::World is HLL::World {
857 857 );
858 858 self.add_fixup_task(:fixup_past($fixups), :deserialize_past($fixups));
859 859 }
  860 +
  861 + # put an expression in sink context
  862 + method past_sink($past) {
  863 + my $name := $past.unique('sink');
  864 + QAST::Stmts.new(
  865 + QAST::Op.new(:op<bind>,
  866 + QAST::Var.new(:$name, :scope<local>, :decl<var>),
  867 + $past,
  868 + ),
  869 + QAST::Op.new(:op<if>,
  870 + QAST::Op.new(:op<if>,
  871 + QAST::Op.new(:op<isconcrete>,
  872 + QAST::Var.new(:$name, :scope<local>),
  873 + ),
  874 + QAST::Op.new(:op<if>,
  875 + QAST::Op.new(:op<can>,
  876 + QAST::Var.new(:$name, :scope<local>),
  877 + QAST::SVal.new(:value('sink')),
  878 + ),
  879 + QAST::Op.new(:op<defined>,
  880 + QAST::Var.new(:$name, :scope<local>),
  881 + )
  882 + )
  883 + ),
  884 + QAST::Op.new(:op<callmethod>, :name<sink>,
  885 + QAST::Var.new(:$name, :scope<local>),
  886 + ),
  887 + ),
  888 + );
  889 + }
  890 +
  891 + # put an expression into potential sink context
  892 + method sink($past) {
  893 + my $name := $past.unique('sink');
  894 + QAST::Want.new(
  895 + $past,
  896 + 'v',
  897 + self.past_sink($past)
  898 + );
  899 + }
  900 +
860 901
861 902 # Generates code for running phasers.
862   - method run_phasers_code($code, $block_type, $type) {
  903 + method run_phasers_code($code, $block_type, $type, :$sink) {
  904 + my $call := QAST::Op.new(
  905 + :op('call'),
  906 + QAST::Var.new( :scope('lexical'), :name('$_'), :decl('param') )
  907 + );
  908 + if $sink {
  909 + $call := self.past_sink($call);
  910 + }
863 911 QAST::Op.new(
864 912 :op('for'),
865 913 QAST::Op.new(
@@ -872,11 +920,10 @@ class Perl6::World is HLL::World {
872 920 QAST::SVal.new( :value($type) )
873 921 ),
874 922 QAST::Block.new(
875   - :blocktype('immediate'),
876   - QAST::Op.new(
877   - :op('call'),
878   - QAST::Var.new( :scope('lexical'), :name('$_'), :decl('param') )
879   - )))
  923 + :blocktype('immediate'),
  924 + $call
  925 + )
  926 + )
880 927 }
881 928
882 929 # Adds any extra code needing for handling phasers.
@@ -893,10 +940,10 @@ class Perl6::World is HLL::World {
893 940 $code_past[0].push(QAST::Op.new(
894 941 :op('if'),
895 942 QAST::Op.new( :op('p6takefirstflag') ),
896   - self.run_phasers_code($code, $block_type, 'FIRST')));
  943 + self.run_phasers_code($code, $block_type, 'FIRST', :sink)));
897 944 }
898 945 if nqp::existskey(%phasers, 'ENTER') {
899   - $code_past[0].push(self.run_phasers_code($code, $block_type, 'ENTER'));
  946 + $code_past[0].push(self.run_phasers_code($code, $block_type, 'ENTER', :sink));
900 947 }
901 948 if nqp::existskey(%phasers, '!LEAVE-ORDER') || nqp::existskey(%phasers, 'POST') {
902 949 $code_past[+@($code_past) - 1] := QAST::Op.new(

0 comments on commit d30d7bc

Please sign in to comment.
Something went wrong with that request. Please try again.