diff --git a/SAFE.setting b/SAFE.setting index 33293fb2..4f0cddd5 100644 --- a/SAFE.setting +++ b/SAFE.setting @@ -761,10 +761,51 @@ my class Array is List { $!items = Q:CgOp { (varattr items (@ (l $inn))) }; self; } + + method !extend is rawcall { + Q:CgOp { + (letn i (unbox List (getattr items (@ (pos 0)))) + ct (- (cast Int32 (unbox Double (@ (pos 1)))) + (getfield Count (l i))) + (ternary (>= (l ct) (int 0)) [prog] + [die "Autovivification collision"]) + (whileloop 0 0 (!= (l ct) (int 0)) + (prog + (l ct (- (l ct) (int 1))) + (rawcall (l i) Add (newrwscalar (@ (l Any)))))) + (rawcall (l i) Add (pos 2)) + (null Variable)) + }; + } + + method at-pos($ix) { + self!fill($ix+1) + ?? $!items.at-pos($ix) + !! Any!butWHENCE(sub () is rawcall { + self!extend($ix, Q:CgOp { (pos 0) }); + }); + } } PRE-INIT { Q:CgOp { (prog (rawsset Kernel.ArrayP (@ (l Array))) (null Variable)) }; + Any.HOW.add-method("at-pos", anon method at-pos($ix) { + ($ix == 0) ?? self !! die("Invalid index on non-list") + }); +} + +sub postcircumfix:<[ ]> is rawcall { + my $index ::= Q:CgOp { (pos 1) }; + + (Q:CgOp { (pos 0) }).defined + ?? (Q:CgOp { (pos 0) }).at-pos($index) + !! Any!butWHENCE(sub () is rawcall { + my $ar := Q:CgOp { (getindex (int 0) (getfield pos + (getfield outer (callframe)))) }; + $ar.defined && die("Autovivification collision"); + $ar = Array.new; + $ar!extend($index, Q:CgOp { (pos 0) }); + }); } {YOU_ARE_HERE} diff --git a/test.pl b/test.pl index cbd8991a..e6464990 100644 --- a/test.pl +++ b/test.pl @@ -2,7 +2,7 @@ use Test; -plan 184; +plan 196; ok 1, "one is true"; ok 2, "two is also true"; @@ -517,3 +517,35 @@ ok $e, "autovivification after lvalue context"; ok $f, "autovivification after bvalue context"; } + +{ + sub postcircumfix:<[ ]>($a, $b, $c) { $a ~ "|" ~ $b ~ "|" ~ $c } + is 1[2,3], "1|2|3", "can call postcircumfix [ ]"; +} + +{ + sub postcircumfix:<{ }>($a, $b, $c) { $a ~ "|" ~ $b ~ "|" ~ $c } + is 1{2,3}, "1|2|3", 'can call postcircumfix { }'; +} + +{ + my @arr = ; + is @arr.join("|"), 'a|b|c', "word splitter works"; + + my @narr; + @narr[0]; + ok +@narr == 0, "rvalue reference to out of range value does not add"; + @narr[2] = 5; + ok +@narr == 3, "assigning to element 2 makes length 3"; + ok !(@narr[0].defined), "first element undefined"; + ok !(@narr[1].defined), "second element undefined"; + ok @narr[2] == 5, "third element properly assigned"; + + my @darr; + @darr[1][1]; + ok +@darr == 0, "rvalue nested reference, no effect"; + @darr[2][2] = 'pie'; + ok +@darr == 3, "outer level vivifies elements"; + ok @darr[2] ~~ Array, "inner Array created"; + is @darr[2][2], 'pie', "inner value retained"; +} diff --git a/test2.pl b/test2.pl index a85cdaba..ee011c7c 100644 --- a/test2.pl +++ b/test2.pl @@ -1,78 +1,5 @@ # vim: ft=perl6 use Test; -PRE-INIT { - Any.HOW.add-method("at-pos", anon method at-pos($ix) { - ($ix == 0) ?? self !! die("Invalid index on non-list") - }); - - Array.HOW.add-method("!extend", anon method !extend is rawcall { - Q:CgOp { - (letn i (unbox List (getattr items (@ (pos 0)))) - ct (- (cast Int32 (unbox Double (@ (pos 1)))) - (getfield Count (l i))) - (ternary (>= (l ct) (int 0)) [prog] - [die "Autovivification collision"]) - (whileloop 0 0 (!= (l ct) (int 0)) - (prog - (l ct (- (l ct) (int 1))) - (rawcall (l i) Add (newrwscalar (@ (l Any)))))) - (rawcall (l i) Add (pos 2)) - (null Variable)) - }; - }); - - Array.HOW.add-method("at-pos", anon method at-pos($ix) { - self!fill($ix+1) - ?? $!items.at-pos($ix) - !! Any!butWHENCE(sub () is rawcall { - self!extend($ix, Q:CgOp { (pos 0) }); - }); - }); -} - -sub postcircumfix:<[ ]> is rawcall { - my $index ::= Q:CgOp { (pos 1) }; - - (Q:CgOp { (pos 0) }).defined - ?? (Q:CgOp { (pos 0) }).at-pos($index) - !! Any!butWHENCE(sub () is rawcall { - my $ar := Q:CgOp { (getindex (int 0) (getfield pos - (getfield outer (callframe)))) }; - $ar.defined && die("Autovivification collision"); - $ar = Array.new; - $ar!extend($index, Q:CgOp { (pos 0) }); - }); -} - -{ - sub postcircumfix:<[ ]>($a, $b, $c) { $a ~ "|" ~ $b ~ "|" ~ $c } - is 1[2,3], "1|2|3", "can call postcircumfix [ ]"; -} - -{ - sub postcircumfix:<{ }>($a, $b, $c) { $a ~ "|" ~ $b ~ "|" ~ $c } - is 1{2,3}, "1|2|3", 'can call postcircumfix { }'; -} - -my @arr = ; -is @arr.join("|"), 'a|b|c', "word splitter works"; - -my @narr; -@narr[0]; -ok +@narr == 0, "rvalue reference to out of range value does not add"; -@narr[2] = 5; -ok +@narr == 3, "assigning to element 2 makes length 3"; -ok !(@narr[0].defined), "first element undefined"; -ok !(@narr[1].defined), "second element undefined"; -ok @narr[2] == 5, "third element properly assigned"; - -my @darr; -@darr[1][1]; -ok +@darr == 0, "rvalue nested reference, no effect"; -@darr[2][2] = 'pie'; -ok +@darr == 3, "outer level vivifies elements"; -ok @darr[2] ~~ Array, "inner Array created"; -is @darr[2][2], 'pie', "inner value retained"; done-testing;