diff --git a/lib/Kernel.cs b/lib/Kernel.cs index 1f7bbaa5..ae9b5534 100644 --- a/lib/Kernel.cs +++ b/lib/Kernel.cs @@ -992,13 +992,11 @@ public class Kernel { return w.Do(th, v); } + // this exists purely to hide the return value private static SubInfo BindSI = new SubInfo("Bind/rw-viv", BindC); private static Frame BindC(Frame th) { switch (th.ip) { case 0: - th.ip = 1; - return Vivify(th, th.pos[0]); - case 1: return th.caller; default: return Kernel.Die(th, "IP invalid"); @@ -1043,8 +1041,7 @@ public class Kernel { th.resultSlot = rhs; - n = th.MakeChild(null, BindSI); - n.pos = new Variable[1] { rhs }; + n = Vivify(th, rhs).MakeChild(null, BindSI); return n; } @@ -1056,7 +1053,9 @@ public class Kernel { if (th.pos[0].whence == null) goto case 1; th.ip = 1; - return Vivify(th, th.pos[0]); + Frame nth = Vivify(th, th.pos[0]); + if (nth == th) goto case 1; + return nth; case 1: if (th.pos[0].islist) { return th.pos[0].Fetch().InvokeMethod(th.caller, diff --git a/lib/SAFE.setting b/lib/SAFE.setting index d35b3cc9..b5024e22 100644 --- a/lib/SAFE.setting +++ b/lib/SAFE.setting @@ -734,18 +734,15 @@ my class Hash { method iterator () { self.list.iterator } method dump () { '{' ~ self.list.map(*.dump).join(', ') ~ '}' } - # TODO: We need something like pir:: notation for this to not suck method at-key($key) { + my $ks ::= Q:CgOp { (obj_asstr {$key}) }; Q:CgOp { - (box Bool (varhash_contains_key [unbox varhash (@ {self})] - [obj_getstr {$key}])) + (letn vh (unbox varhash (@ {self})) + ky (unbox str (@ {$ks})) + (ternary (varhash_contains_key (l vh) (l ky)) + (varhash_getindex (l ky) (l vh)) + (newvhashvar (class_ref mo Any) (@ {self}) (l ky) (@ {Any})))) } - ?? Q:CgOp { - (varhash_getindex [obj_getstr {$key}] - [unbox varhash (@ {self})]) - } !! Any!Any::butWHENCE(sub (\$var) { - self!extend($key, $var) - }); } } diff --git a/perf/hashmark.pl b/perf/hashmark.pl index a778e525..9807d246 100644 --- a/perf/hashmark.pl +++ b/perf/hashmark.pl @@ -1,22 +1,6 @@ # vim: ft=perl6 use MONKEY_TYPING; augment class Hash { - method at-key($key) { - my $ks ::= Q:CgOp { (obj_asstr {$ks}) }; - Q:CgOp { - (letn vh (unbox varhash (@ {self})) - ky (unbox str (@ {$ks})) - (ternary (varhash_contains_key (l vh) (l ky)) - (varhash_getindex (l ky) (l vh)) - {Any!Any::butWHENCE(sub (\$var) { - Q:CgOp { - (letn d [unbox varhash (@ {self})] - k [obj_getstr {$ks}] - [varhash_setindex (l k) (l d) {$var}] - [null var]) - }})})) - } - } } augment class Array { diff --git a/src/CgOp.pm b/src/CgOp.pm index 18856315..2c7c3503 100644 --- a/src/CgOp.pm +++ b/src/CgOp.pm @@ -161,6 +161,8 @@ use warnings; sub varhash_new { rawnew('varhash') } sub newvsubvar { rawnew('clr:SimpleVariable', bool(1), bool(0), $_[0], rawnew('clr:SubViviHook', $_[1]), $_[2]) } + sub newvhashvar { rawnew('clr:SimpleVariable', bool(1), bool(0), $_[0], rawnew('clr:HashViviHook', $_[1], $_[2]), $_[3]) } + sub newvarrayvar { rawnew('clr:SimpleVariable', bool(1), bool(0), $_[0], rawnew('clr:ArrayViviHook', $_[1], $_[2]), $_[3]) } sub poscount { getfield('Length', getfield('pos', callframe())) } sub num_to_string { rawcall($_[0], 'ToString') }