Implement assignment autovivification; fold autoviv into main code

Kernel.cs

@@ -548,6 +548,11 @@ public class Kernel {
         private static Frame AssignC(Frame th) {
             switch (th.ip) {
                 case 0:
+                    if (th.pos[0].whence == null)
+                        goto case 1;
+                    th.ip = 1;
+                    return Vivify(th, th.pos[0]);
+                case 1:
                     if (!th.pos[0].rw) {
                         throw new Exception("assigning to readonly value");
                     }
@@ -559,11 +564,11 @@ public class Kernel {
                             return th.pos[0].container.Store(th.caller,
                                     th.pos[1].container);
                         } else {
-                            th.ip = 1;
+                            th.ip = 2;
                             return th.pos[1].container.Fetch(th);
                         }
                     }
-                case 1:
+                case 2:
                     return th.pos[0].container.Store(th.caller,
                             (IP6)th.resultSlot);
                 default:

Niecza/Actions.pm

@@ -439,10 +439,7 @@ sub INFIX { my ($cl, $M) = @_;
     my ($st,$l,$r) = $cl->whatever_precheck($s, $M->{left}{_ast},
         $M->{right}{_ast});
 
-    if ($s eq '&infix:<:=>') { #XXX macro
-        $M->{_ast} = Op::Bind->new(node($M), lhs => $l, rhs => $r,
-            readonly => 0);
-    } elsif ($s eq '&infix:<?? !!>') { # XXX macro
+    if ($s eq '&infix:<?? !!>') { # XXX macro
         $M->{_ast} = Op::Conditional->new(node($M), check => $l,
             true => $M->{middle}{_ast}, false => $r);
     } elsif ($s eq '&infix:<,>') {

SAFE.setting

@@ -315,8 +315,10 @@ sub prefix:<++>($v) { $v = ($v + 1); $v }
 sub postfix:<-->($v) { my $old = $v; $v = ($v - 1); $old }
 sub postfix:<++>($v) { my $old = $v; $v = ($v + 1); $old }
 
-# actually a macro
-# sub infix:<:=>($l,$r) { ... }
+sub infix:<:=> is rawcall { Q:CgOp {
+    (prog [bind 0 (pos 0) (pos 1)] [pos 0]) } }
+sub infix:<::=> is rawcall { Q:CgOp {
+    (prog [bind 1 (pos 0) (pos 1)] [pos 0]) } }
 
 sub prefix:<~>($v) { $v.Str } # should be Stringy
 sub prefix:<?>($v) { $v.Bool }
@@ -392,6 +394,10 @@ PRE-INIT {
     Any.HOW.add-method("flat", anon method flat() { self, });
 
     Any.HOW.add-method("ACCEPTS", anon method ACCEPTS($t) { self === $t });
+    Any.HOW.add-method('!butWHENCE', anon method !butWHENCE($cr) {
+        Q:CgOp { (rawnew Variable (bool 1) (bool 1) (bool 0) (@ (l $cr))
+                   (rawscall Kernel.MakeSC (@ (l self)))) }
+    });
 
     # Should be for Block, not Sub
     Sub.HOW.add-method("ACCEPTS", anon method ACCEPTS($t) { (self)($t) });

test.pl

@@ -2,7 +2,7 @@
 
 use Test;
 
-plan 178;
+plan 184;
 
 ok 1, "one is true";
 ok 2, "two is also true";
@@ -494,3 +494,26 @@
     ok @y.elems == 5, "self assignment works (1)";
     is @y.join("|"), '5|1|2|3|4', "self assignment works (2)";
 }
+
+{
+    my $a = 0;
+    my $b = 0;
+    my $c = 0;
+    my $d = 0;
+    my $e = 0;
+    my $f = 0;
+
+    (Any!butWHENCE({ $a = 1 }));
+    my $x := (Any!butWHENCE({ $b = 1 }));  #OK not used
+    my $y ::= (Any!butWHENCE({ $c = 1 })); #OK not used
+    my $z = (Any!butWHENCE({ $d = 1 }));   #OK not used
+    (Any!butWHENCE({ $e = 1 })) = 2;
+    (Any!butWHENCE({ $f = 1 })) := 3;
+
+    ok !$a, "no autovivification in void context";
+    ok $b, "autovivification after rw bind";
+    ok !$c, "no autovivification after ro bind";
+    ok !$d, "no autovivification after rvalue context";
+    ok $e, "autovivification after lvalue context";
+    ok $f, "autovivification after bvalue context";
+}

test2.pl

@@ -1,37 +1,5 @@
 # vim: ft=perl6
 use Test;
 
-PRE-INIT {
-    Any.HOW.add-method('!butWHENCE', anon method !butWHENCE($cr) {
-        Q:CgOp { (rawnew Variable (bool 1) (bool 1) (bool 0) (@ (l $cr))
-                   (rawscall Kernel.MakeSC (@ (l self)))) }
-    });
-}
-
-sub infix:<:=> is rawcall { Q:CgOp {
-    (prog [bind (bool 0) (pos 0) (pos 1)] [pos 0]) } }
-sub infix:<::=> is rawcall { Q:CgOp {
-    (prog [bind (bool 1) (pos 0) (pos 1)] [pos 0]) } }
-
-my $a = 0;
-my $b = 0;
-my $c = 0;
-my $d = 0;
-my $e = 0;
-my $f = 0;
-
-(Any!butWHENCE({ $a = 1 }));
-my $x := (Any!butWHENCE({ $b = 1 }));
-my $y ::= (Any!butWHENCE({ $c = 1 }));
-my $z = (Any!butWHENCE({ $d = 1 }));
-(Any!butWHENCE({ $e = 1 })) = 2;
-(Any!butWHENCE({ $f = 1 })) := 3;
-
-ok !$a, "no autovivification in void context";
-ok $b, "autovivification after rw bind";
-ok !$c, "no autovivification after ro bind";
-ok !$d, "no autovivification after rvalue context";
-ok $e, "autovivification after lvalue context";
-ok $f, "autovivification after bvalue context";
 
 done-testing;