Use specialized WHENCE for Hash.at-key

sorear · Nov 27, 2010 · 115676a · 115676a
1 parent cb623ff
commit 115676a
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 31 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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') }