From b10a518e4f8a6cae9c16eda4faef510ce7ca3c4c Mon Sep 17 00:00:00 2001 From: jnthn Date: Sat, 23 Feb 2013 18:14:38 +0100 Subject: [PATCH] Native keyed ops. --- lib/QAST/JASTCompiler.nqp | 6 +++ src/org/perl6/nqp/runtime/Ops.java | 39 +++++++++++++++++++ .../perl6/nqp/sixmodel/SixModelObject.java | 6 +++ 3 files changed, 51 insertions(+) diff --git a/lib/QAST/JASTCompiler.nqp b/lib/QAST/JASTCompiler.nqp index f4cf68e..f7d9d6d 100644 --- 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 index 340777f..d07f0ee 100644 --- 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 index 9b9e4dd..360af42 100644 --- 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"); }