Implement START phaser

Niecza/Actions.pm

@@ -882,6 +882,21 @@ sub routine_declarator__S_method { my ($cl, $M) = @_;
 my $next_anon_id = 0;
 sub gensym { 'anon_' . ($next_anon_id++) }
 
+sub statevar { my ($cl) = @_;
+    my $var = $cl->gensym;
+    my $blk = $::CURLEX;
+
+    # the top block only runs once, and in any case we can't hack $*SETTING
+    if ($blk != $::UNIT) {
+        $blk = $cl->get_outer($blk);
+    }
+
+    push @{ $blk->{'!decls'} //= [] },
+        Decl::SimpleVar->new(slot => $var);
+
+    $var;
+}
+
 sub blockcheck { my ($cl) = @_;
     for my $d (@{ $::CURLEX->{'!decls'} // [] }) {
         for my $sl ($d->used_slots) {
@@ -1043,6 +1058,13 @@ sub statement_prefix__S_PREMinusINIT { my ($cl, $M) = @_;
     $M->{_ast} = Op::Lexical->new(name => $var);
 }
 
+sub statement_prefix__S_START { my ($cl, $M) = @_;
+    my $var = $cl->statevar;
+
+    $M->{_ast} = Op::Start->new(condvar => $var, body =>
+        $cl->block_to_immediate($M->{blast}{_ast}));
+}
+
 sub comp_unit { my ($cl, $M) = @_;
     my $body = $cl->sl_to_block($M->{statementlist}{_ast},
         subname => 'mainline');

Op.pm

@@ -218,6 +218,35 @@ use CgOp;
     no Moose;
 }
 
+# only for state $x will start and START{} in void context, yet
+{
+    package Op::Start;
+    use Moose;
+    extends 'Op';
+
+    # possibly should use a raw boolean somehow
+    has condvar => (isa => 'Str', is => 'ro', required => 1);
+    has body => (isa => 'Op', is => 'ro', required => 1);
+
+    sub code {
+        my ($self, $body) = @_;
+
+        CgOp::ternary(
+            CgOp::unbox('Boolean',
+                CgOp::fetch(
+                    CgOp::methodcall(CgOp::scopedlex($self->condvar), "Bool"))),
+            CgOp::wrap(CgOp::null('object')),
+            CgOp::prog(
+                CgOp::assign(CgOp::scopedlex($self->condvar),
+                    CgOp::box('Bool', CgOp::bool(1))),
+                $self->body->code($body)));
+    }
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
+
 {
     package Op::Num;
     use Moose;

test.pl

@@ -10,7 +10,7 @@ ($num)
     say ("1.." ~ $num);
 }
 
-plan 49;
+plan 53;
 
 ok 1, "one is true";
 ok 2, "two is also true";
@@ -148,3 +148,50 @@ ($num)
     ok Foo.pie eq 'A', "can call methods through self";
     ok Bar.pie eq 'C', "calls through self are virtual";
 }
+
+{
+    my $x = 0;
+    {
+        START { $x = 1 };
+        ok $x, "START blocks are run";
+    }
+}
+
+{
+    my $x = '';
+    {
+        $x = $x ~ '1';
+        START { $x = $x ~ '2'; }
+        $x = $x ~ '3';
+    }
+    ok $x eq '123', "START blocks are run in order with other code";
+}
+
+{
+    my $x = '';
+    my $y = 0;
+    while $y < 3 {
+        $x = $x ~ '1';
+        START { $x = $x ~ '2'; }
+        $x = $x ~ '3';
+        $y++;
+    }
+    ok $x eq '1231313', "START blocks are only run once";
+}
+
+{
+    my $x = '';
+    my $z = 0;
+    while $z < 2 {
+        my $y = 0;
+        while $y < 3 {
+            $x = $x ~ '1';
+            START { $x = $x ~ '2'; }
+            $x = $x ~ '3';
+            $y++;
+        }
+        $z++;
+    }
+    ok $x eq '12313131231313', "START blocks reset on clone";
+}
+