Merge pull request #13 from tadzik/existspos

Implement and test existspos

docs/LHF.md

@@ -2,10 +2,8 @@
 Some (comparatively :-)) easy tasks for those who want to get involved.
 
 ## Missing positional ops
-Implement and test existspos and deletepos. These need new static method adding
-to Ops. existspos is implementable in terms of elems and <. Note that if the value
-passed in is negative, it should add the element count to it. Next, add an op
-for deletepos, which could be done in terms of splice.
+Implement and test deletepos. These need new static method adding
+to Ops. add an op for deletepos, which could be done in terms of splice.
 
 ## Port xor
 The code-gen for QAST::Op type xor needs porting. Potentially a bit fiddly, but

lib/QAST/JASTCompiler.nqp

@@ -1336,6 +1336,7 @@ QAST::OperationsJAST.map_classlib_core_op('atpos', $TYPE_OPS, 'atpos', [$RT_OBJ,
 QAST::OperationsJAST.map_classlib_core_op('atkey', $TYPE_OPS, 'atkey', [$RT_OBJ, $RT_STR], $RT_OBJ, :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('bindkey', $TYPE_OPS, 'bindkey', [$RT_OBJ, $RT_STR, $RT_OBJ], $RT_OBJ, :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);
 QAST::OperationsJAST.map_classlib_core_op('elems', $TYPE_OPS, 'elems', [$RT_OBJ], $RT_INT, :tc);

src/org/perl6/nqp/runtime/Ops.java

@@ -1251,6 +1251,9 @@ public static double time_n() {
     public static long elems(SixModelObject agg, ThreadContext tc) {
         return agg.elems(tc);
     }
+    public static long existspos(SixModelObject agg, long key, ThreadContext tc) {
+        return agg.exists_pos(tc, key);
+    }
     public static long islist(SixModelObject obj, ThreadContext tc) {
         return obj.st.REPR instanceof VMArray ? 1 : 0;
     }

src/org/perl6/nqp/sixmodel/SixModelObject.java

@@ -112,6 +112,9 @@ public void bind_key_boxed(ThreadContext tc, String key, SixModelObject value) {
     public long exists_key(ThreadContext tc, String key) {
         throw new RuntimeException("This representation does not implement exists_key");
     }
+    public long exists_pos(ThreadContext tc, long key) {
+        throw new RuntimeException("This representation does not implement exists_key");
+    }
     public void delete_key(ThreadContext tc, String key) {
         throw new RuntimeException("This representation does not implement delete_key");
     }

src/org/perl6/nqp/sixmodel/reprs/VMArrayInstance.java

@@ -24,6 +24,16 @@ else if (index >= elems)
         return slots[start + (int)index];
     }
 
+    public long exists_pos(ThreadContext tc, long key) {
+        if (key < 0) {
+            key += this.elems;
+        }
+        if (key >= 0 && key < this.elems) {
+            return (this.slots[(int)key] != null) ? 1 : 0;
+        }
+        return 0;
+    }
+
     private void set_size_internal(ThreadContext tc, long n) {
         long elems = this.elems;
         long start = this.start;

t/nqp/59-nqpop.t

@@ -2,7 +2,7 @@
 
 # Test nqp::op pseudo-functions.
 
-plan(94);
+plan(101);
 
 
 ok( nqp::add_i(5,2) == 7, 'nqp::add_i');
@@ -129,3 +129,14 @@ my %hash;
 %hash<foo> := 1;
 ok( nqp::existskey(%hash,"foo"),"existskey with existing key");
 ok( !nqp::existskey(%hash,"bar"),"existskey with missing key");
+
+my @arr;
+@arr[1] := 3;
+ok(!nqp::existspos(@arr, 0), 'existspos with missing pos');
+ok(nqp::existspos(@arr, 1), 'existspos with existing pos');
+ok(!nqp::existspos(@arr, 2), 'existspos with missing pos');
+ok(nqp::existspos(@arr, -1), 'existspos with existing pos');
+ok(!nqp::existspos(@arr, -2), 'existspos with missing pos');
+ok(!nqp::existspos(@arr, -100), 'existspos with absurd values');
+@arr[1] := NQPMu;
+ok(nqp::existspos(@arr, 1), 'existspos with still existing pos');