From 8a0b8ba71bd448044e119a11f8f53d68871d3b5d Mon Sep 17 00:00:00 2001
From: Stefan O'Rear <stefanor@cox.net>
Date: Sat, 7 Aug 2010 00:46:02 -0700
Subject: [PATCH] Prototype hash access and autovivification

---
 CodeGen.pm | 27 ++++++++++++++++++---------
 test2.pl   | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 9 deletions(-)

diff --git a/CodeGen.pm b/CodeGen.pm
index fa7b1310..887263c7 100644
--- a/CodeGen.pm
+++ b/CodeGen.pm
@@ -27,15 +27,6 @@ use 5.010;
               superclasses => [f => 'List<DynMetaObject>'],
               name         => [f => 'String'] },
 
-        'List<DynMetaObject>' =>
-            { Add          => [m => 'Void'] },
-        'List<Variable>' =>
-            { Add          => [m => 'Void'],
-              Insert       => [m => 'Void'],
-              RemoveAt     => [m => 'Void'],
-              Count        => [f => 'Int32'] },
-        'Variable[]' =>
-            { Length       => [f => 'Int32'] },
         'Double' =>
             { ToString     => [m => 'String'] },
         'Variable' =>
@@ -110,8 +101,26 @@ use 5.010;
     }
     __PACKAGE__->know_module('NULL');
 
+    sub _generic_infer {
+        /Dictionary<(.*),(.*)>/ && return {
+            ContainsKey         => [ m => 'Boolean' ],
+        };
+        /List<(.*)>/ && return {
+            Add                 => [m => 'Void'],
+            Insert              => [m => 'Void'],
+            RemoveAt            => [m => 'Void'],
+            Count               => [f => 'Int32'],
+        };
+        /(.*)\[\]/ && return {
+            Length              => [f => 'Int32'],
+        };
+    }
+
     sub _typedata {
         my ($self, $types, @path) = @_;
+
+        for ($path[0]) { $typedata{$_} //= _generic_infer; }
+
         my $cursor = \%typedata;
         for (@path) { $cursor = $cursor->{$_}; }
         if (!defined $cursor) {
diff --git a/test2.pl b/test2.pl
index ee011c7c..77ad6416 100644
--- a/test2.pl
+++ b/test2.pl
@@ -1,5 +1,58 @@
 # vim: ft=perl6
 use Test;
 
+my class Hash {
+    method new() { Q:CgOp { (box Hash (rawnew Dictionary<string,Variable>)) } }
+    method !extend is rawcall {
+        Q:CgOp {
+            (letn d [unbox Dictionary<string,Variable> (@ (pos 0))]
+                  k [unbox String (@ (methodcall (pos 1) Str))]
+              [ternary (rawcall (l d) ContainsKey (l k))
+                (die "Autovivification collision")
+                (prog)]
+              [setindex (l k) (l d) (pos 2)]
+              [null Variable])
+        };
+    }
+
+    # TODO: We need something like pir:: notation for this to not suck
+    method at-key($key) {
+        Q:CgOp {
+            (box Bool (rawcall [unbox Dictionary<string,Variable> (@ (l self))]
+                ContainsKey [unbox String (@ (methodcall (l $key) Str))]))
+        }
+            ?? Q:CgOp {
+                (getindex [unbox String (@ (methodcall (l $key) Str))]
+                  [unbox Dictionary<string,Variable> (@ (l self))])
+            } !! Any!butWHENCE({ self!extend($key, Q:CgOp { (pos 0) }) });
+    }
+}
+
+sub postcircumfix:<{ }> is rawcall {
+    my $key ::= Q:CgOp { (pos 1) };
+
+    (Q:CgOp { (pos 0) }).defined
+        ?? (Q:CgOp { (pos 0) }).at-key($key)
+        !! Any!butWHENCE(sub () is rawcall {
+            my $ar := Q:CgOp { (getindex (int 0) (getfield pos
+                                 (getfield outer (callframe)))) };
+            $ar.defined && die("Autovivification collision");
+            $ar = Hash.new;
+            $ar!extend($key, Q:CgOp { (pos 0) });
+        });
+}
+
+my $foo;
+ok !($foo{'x'}.defined), "fetch from hash, no value";
+ok !($foo.defined), "no autoviv for rvalue";
+$foo{'x'} = 'foo';
+is $foo{'x'}, 'foo', "values are retained";
+ok !($foo{'y'}.defined), "no cross-slot leakage";
+ok $foo ~~ Hash, "foo isa hash now";
+$foo{'z'}{'a'} = 'pie';
+is $foo{'z'}{'a'}, 'pie', "can autoviv deeply";
+$foo{'y'}[2] = 'zed';
+is $foo{'y'}[2], 'zed', "can mix array and hash viv";
+
 
 done-testing;