Add checkpoints to generated code to prevent the "warnings and some e…

…rrors slide to a nearby call" failure (#120)

lib/CodeGen.cs

@@ -1779,6 +1779,20 @@ class CpsOp {
             return new CpsOp(stmts.ToArray(), new ClrResult(body.head.Returns));
         }
 
+        public static CpsOp SyncBefore(CpsOp z) {
+            if (z.stmts.Length != 0 && z.stmts[0] == ClrSync.Instance)
+                return z;
+            if (z.head is ClrSync)
+                return z;
+            // TODO: it's not really necessary to force a full cps-format
+            // node here.  But we don't have universal recursion for
+            // non-cps nodes.
+            ClrOp[] body = new ClrOp[z.stmts.Length + 1];
+            Array.Copy(z.stmts, 0, body, 1, body.Length - 1);
+            body[0] = ClrSync.Instance;
+            return new CpsOp(body, z.head);
+        }
+
         public static CpsOp Ternary(CpsOp cond, CpsOp iftrue, CpsOp iffalse) {
             ClrOp iftrue_h = iftrue.head;
             ClrOp iffalse_h = iffalse.head;
@@ -2450,6 +2464,8 @@ class NamProcessor {
                 return CpsOp.BoolLiteral(FixBool(zyg[1])); };
             handlers["ann"] = delegate(NamProcessor th, object[] zyg) {
                 return CpsOp.Annotate(FixInt(zyg[1]), th.Scan(zyg[2])); };
+            thandlers["statement"] = delegate(CpsOp[] z) {
+                return CpsOp.SyncBefore(z[0]); };
             handlers["label"] = delegate(NamProcessor th, object[] z) {
                 return CpsOp.Label(FixStr(z[1]), true);
             };

src/CgOp.pm6

@@ -55,7 +55,7 @@ CgOp._register_ops: <
         rxsetclass rxsetpos rxsetquant rxstripcaps say scopedlex setbox
         setfield setindex setslot set_status sig_slurp_capture sink slurp
         span specificlex spew stab_privatemethod stab_what startgather
-        start_iter status_get str strbuf_append strbuf_new strbuf_seal
+        start_iter statement status_get str strbuf_append strbuf_new strbuf_seal
         str_chr strcmp str_flip str_length str_substring str_tolower
         str_tonum str_toupper take ternary to_json to_jsync treader_getc
         treader_getline treader_open treader_slurp treader_stdin unbox

src/NieczaActions.pm6

@@ -3418,7 +3418,7 @@ method statement_mod_loop:for ($/)    { self.statement_mod_loop($/) }
 method statement_mod_loop:given ($/)  { self.statement_mod_loop($/) }
 
 method statementlist($/) {
-    make $OpStatementList.new(pos=>$/, children =>
+    make $OpStatementList.new(pos=>$/, :statement, children =>
         [ map *.statement_level($/), map *.ast, @( $<statement> ) ]);
 }
 

src/NieczaPassSimplifier.pm6

@@ -91,30 +91,30 @@ our %funcs = (
 sub do_builtin($name, $expect) { sub ($body, $nv, $invname, $op) { #OK not used
     return $op unless defined my $args = no_named_params($op);
     return $op unless $args ~~ $expect;
-    return $OpBuiltin.new(name => $name, args => $args);
+    return $OpBuiltin.new(pos => $op.pos, name => $name, args => $args);
 } }
 
 sub do_return_take($body, $nv, $invname, $op) { #OK not used
     return $op unless defined my $args = no_named_params($op);
     my $parcel = ($args == 1 ?? $args[0] !!
-        $args == 0 ?? $OpLexical.new(name => 'Nil') !!
+        $args == 0 ?? $OpLexical.new(pos => $op.pos, name => 'Nil') !!
         $OpCallSub.new(invocant => $OpLexical.new(name => '&infix:<,>'),
-            positionals => [@$args]));
+            pos => $op.pos, positionals => [@$args]));
     return ($invname eq '&take' ??
-        $OpTake.new(value => $parcel) !!
-        $OpControl.new(payload => $parcel,
+        $OpTake.new(pos => $op.pos, value => $parcel) !!
+        $OpControl.new(pos => $op.pos, payload => $parcel,
             number => $invname eq '&return' ?? 4 !! 6));
 }
 
 sub do_nullary_control($number) { sub ($body, $nv, $ , $op) { #OK not used
     return $op unless defined my $args = no_named_params($op);
     return $op unless $args == 0;
-    return $OpControl.new(:$number, payload => $OpLexical.new(name => 'Nil'));
+    return $OpControl.new(:$number, pos => $op.pos, payload => $OpLexical.new(name => 'Nil'));
 } }
 
 sub do_makejunction($typecode) { sub ($body, $nv, $ , $op) { #OK not used
     return $op unless defined my $args = no_named_params($op);
-    return $OpMakeJunction.new(:$typecode, zyg => @$args);
+    return $OpMakeJunction.new(pos => $op.pos, :$typecode, zyg => @$args);
 } }
 
 sub do_atkey($body, $nv, $invname, $op) { #OK not used
@@ -126,14 +126,14 @@ sub do_atkey($body, $nv, $invname, $op) { #OK not used
     return $op if $delete && (!$delete.^isa($OpLexical) || $delete.name ne 'True');
     return $op if $exists && (!$exists.^isa($OpLexical) || $exists.name ne 'True');
     return $op if $delete && $exists;
-    return $OpBuiltin.new(name => ($delete ?? 'delete_key' !!
+    return $OpBuiltin.new(pos => $op.pos, name => ($delete ?? 'delete_key' !!
             $exists ?? 'exists_key' !! 'at_key'), args => $args);
 }
 
 sub do_atpos($body, $nv, $invname, $op) { #OK not used
     return $op unless defined my $args = no_named_params($op);
     return $op unless $args == 2;
-    return $OpBuiltin.new(name => 'at_pos', args => $args);
+    return $OpBuiltin.new(pos => $op.pos, name => 'at_pos', args => $args);
 }
 
 # XXX should support folding of SimplePair, SimpleParcel too
@@ -154,7 +154,7 @@ sub check_folding($body, $sub, $op) {
         worry "Operation cannot succeed (constant folding threw exception: $/.prematch())";
         return;
     }
-    $OpGeneralConst.new(value => $ret);
+    $OpGeneralConst.new(pos => $op.pos, value => $ret);
 }
 
 sub run_optree($body, $op, $nv) {
@@ -186,7 +186,7 @@ sub run_optree($body, $op, $nv) {
         return $op unless defined my $args = no_named_params($op);
         return $op unless $args >= $B[1] &&
             (!defined($B[2]) || $args <= $B[2]);
-        return $OpBuiltin.new(name => $B[0], args => $args);
+        return $OpBuiltin.new(pos => $op.pos, name => $B[0], args => $args);
     }
 
     return $op unless @inv_lex[4].unit.name eq 'CORE';

src/Op.pm6

@@ -44,6 +44,14 @@ method cgop_labelled($body, $label) {
     }
 }
 
+method cgop_statement($body) {
+    if $!pos -> $p {
+        $CgOp.ann($p.CURSOR.lineof($p.pos), $CgOp.statement(self.code($body)));
+    } else {
+        $CgOp.statement(self.code($body));
+    }
+}
+
 method code_labelled($body, $label) { self.code($body) } #OK not used
 
 method statement_level($/) { self }
@@ -82,6 +90,7 @@ method const_value($) { }
 
 class StatementList is Op {
     has $.children = []; # Array of Op
+    has Bool $.statement;
     method new(:$children = [], *%_) {
         self.bless(*, children => [ @$children ], |%_);
     }
@@ -94,7 +103,8 @@ class StatementList is Op {
     method onlystub() { $!children && $!children[0].onlystub }
     method const_value($body) { $!children[0].const_value($body) if $!children == 1 }
     method code($body) {
-        my @ch = map { $_.cgop($body) }, @$.children;
+        my @ch = map ($!statement ?? *.cgop_statement($body) !! *.cgop($body)),
+            @$.children;
         my $end = @ch ?? pop(@ch) !! $CgOp.corelex('Nil');
 
         $CgOp.prog((map { $CgOp.sink($_) }, @ch), $end);