Native keyed ops.

jnthn · Feb 23, 2013 · b10a518 · b10a518
1 parent ca471ee
commit b10a518
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 0 deletions.
diff --git a/lib/QAST/JASTCompiler.nqp b/lib/QAST/JASTCompiler.nqp
@@ -1636,11 +1636,17 @@ QAST::OperationsJAST.map_classlib_core_op('atpos_i', $TYPE_OPS, 'atpos_i', [$RT_
 QAST::OperationsJAST.map_classlib_core_op('atpos_n', $TYPE_OPS, 'atpos_n', [$RT_OBJ, $RT_INT], $RT_NUM, :tc);
 QAST::OperationsJAST.map_classlib_core_op('atpos_s', $TYPE_OPS, 'atpos_s', [$RT_OBJ, $RT_INT], $RT_STR, :tc);
 QAST::OperationsJAST.map_classlib_core_op('atkey', $TYPE_OPS, 'atkey', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('atkey_i', $TYPE_OPS, 'atkey_i', [$RT_OBJ, $RT_STR], $RT_INT, :tc);
+QAST::OperationsJAST.map_classlib_core_op('atkey_n', $TYPE_OPS, 'atkey_n', [$RT_OBJ, $RT_STR], $RT_NUM, :tc);
+QAST::OperationsJAST.map_classlib_core_op('atkey_s', $TYPE_OPS, 'atkey_s', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
 QAST::OperationsJAST.map_classlib_core_op('bindpos', $TYPE_OPS, 'bindpos', [$RT_OBJ, $RT_INT, $RT_OBJ], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('bindpos_i', $TYPE_OPS, 'bindpos_i', [$RT_OBJ, $RT_INT, $RT_INT], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('bindpos_n', $TYPE_OPS, 'bindpos_n', [$RT_OBJ, $RT_INT, $RT_NUM], $RT_NUM, :tc);
 QAST::OperationsJAST.map_classlib_core_op('bindpos_s', $TYPE_OPS, 'bindpos_s', [$RT_OBJ, $RT_INT, $RT_STR], $RT_STR, :tc);
 QAST::OperationsJAST.map_classlib_core_op('bindkey', $TYPE_OPS, 'bindkey', [$RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('bindkey_i', $TYPE_OPS, 'bindkey_i', [$RT_OBJ, $RT_STR, $RT_INT], $RT_INT, :tc);
+QAST::OperationsJAST.map_classlib_core_op('bindkey_n', $TYPE_OPS, 'bindkey_n', [$RT_OBJ, $RT_STR, $RT_NUM], $RT_NUM, :tc);
+QAST::OperationsJAST.map_classlib_core_op('bindkey_s', $TYPE_OPS, 'bindkey_s', [$RT_OBJ, $RT_STR, $RT_STR], $RT_STR, :tc);
 QAST::OperationsJAST.map_classlib_core_op('existspos', $TYPE_OPS, 'existspos', [$RT_OBJ, $RT_INT], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('existskey', $TYPE_OPS, 'existskey', [$RT_OBJ, $RT_STR], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('deletekey', $TYPE_OPS, 'deletekey', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);

diff --git a/src/org/perl6/nqp/runtime/Ops.java b/src/org/perl6/nqp/runtime/Ops.java
@@ -1480,10 +1480,49 @@ public static SixModelObject splice(SixModelObject arr, SixModelObject from, lon
     public static SixModelObject atkey(SixModelObject hash, String key, ThreadContext tc) {
         return hash.at_key_boxed(tc, key);
     }
+    public static long atkey_i(SixModelObject hash, String key, ThreadContext tc) {
+    	hash.at_key_native(tc, key);
+    	if (tc.native_type != ThreadContext.NATIVE_INT)
+    		throw new RuntimeException("This is not a native int hash");
+    	return tc.native_i; 
+    }
+    public static double atkey_n(SixModelObject hash, String key, ThreadContext tc) {
+    	hash.at_key_native(tc, key);
+    	if (tc.native_type != ThreadContext.NATIVE_NUM)
+    		throw new RuntimeException("This is not a native num hash");
+    	return tc.native_n; 
+    }
+    public static String atkey_s(SixModelObject hash, String key, ThreadContext tc) {
+    	hash.at_key_native(tc, key);
+    	if (tc.native_type != ThreadContext.NATIVE_STR)
+    		throw new RuntimeException("This is not a native str hash");
+    	return tc.native_s; 
+    }
     public static SixModelObject bindkey(SixModelObject hash, String key, SixModelObject value, ThreadContext tc) {
         hash.bind_key_boxed(tc, key, value);
         return value;
     }
+    public static long bindkey_i(SixModelObject hash, String key, long value, ThreadContext tc) {
+    	tc.native_i = value;
+    	hash.bind_key_native(tc, key);
+    	if (tc.native_type != ThreadContext.NATIVE_INT)
+    		throw new RuntimeException("This is not a native int hash");
+        return value;
+    }
+    public static double bindkey_n(SixModelObject hash, String key, double value, ThreadContext tc) {
+    	tc.native_n = value;
+    	hash.bind_key_native(tc, key);
+    	if (tc.native_type != ThreadContext.NATIVE_NUM)
+    		throw new RuntimeException("This is not a native num hash");
+        return value;
+    }
+    public static String bindkey_s(SixModelObject hash, String key, String value, ThreadContext tc) {
+    	tc.native_s = value;
+    	hash.bind_key_native(tc, key);
+    	if (tc.native_type != ThreadContext.NATIVE_STR)
+    		throw new RuntimeException("This is not a native str hash");
+        return value;
+    }
     public static long existskey(SixModelObject hash, String key, ThreadContext tc) {
         return hash.exists_key(tc, key);
     }

diff --git a/src/org/perl6/nqp/sixmodel/SixModelObject.java b/src/org/perl6/nqp/sixmodel/SixModelObject.java
@@ -124,9 +124,15 @@ public void splice(ThreadContext tc, SixModelObject from, long offset, long coun
     public SixModelObject at_key_boxed(ThreadContext tc, String key) {
         throw new RuntimeException("This representation does not implement at_key_boxed");
     }
+    public void at_key_native(ThreadContext tc, String key) {
+        throw new RuntimeException("This representation does not implement at_key_native");
+    }
     public void bind_key_boxed(ThreadContext tc, String key, SixModelObject value) {
         throw new RuntimeException("This representation does not implement bind_key_boxed");
     }
+    public void bind_key_native(ThreadContext tc, String key) {
+        throw new RuntimeException("This representation does not implement bind_key_native");
+    }
     public long exists_key(ThreadContext tc, String key) {
         throw new RuntimeException("This representation does not implement exists_key");
     }