map splice operation

jnthn · Jan 12, 2013 · b0afafc · b0afafc
1 parent 46cf0d7
commit b0afafc
Show file tree

Hide file tree

Showing 3 changed files with 126 additions and 1 deletion.
diff --git a/lib/QAST/JASTCompiler.nqp b/lib/QAST/JASTCompiler.nqp
@@ -1086,6 +1086,7 @@ QAST::OperationsJAST.map_classlib_core_op('push', $TYPE_OPS, 'push', [$RT_OBJ, $
 QAST::OperationsJAST.map_classlib_core_op('pop', $TYPE_OPS, 'pop', [$RT_OBJ], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('unshift', $TYPE_OPS, 'unshift', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('shift', $TYPE_OPS, 'shift', [$RT_OBJ], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('splice', $TYPE_OPS, 'splice', [$RT_OBJ, $RT_OBJ, $RT_INT, $RT_INT], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('islist', $TYPE_OPS, 'islist', [$RT_OBJ], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('ishash', $TYPE_OPS, 'ishash', [$RT_OBJ], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('iterator', $TYPE_OPS, 'iter', [$RT_OBJ], $RT_OBJ, :tc);

diff --git a/src/org/perl6/nqp/runtime/Ops.java b/src/org/perl6/nqp/runtime/Ops.java
@@ -760,6 +760,10 @@ public static SixModelObject unshift(SixModelObject arr, SixModelObject value, T
     public static SixModelObject shift(SixModelObject arr, ThreadContext tc) {
         return arr.shift_boxed(tc);
     }
+    public static SixModelObject splice(SixModelObject arr, SixModelObject from, long offset, long count, ThreadContext tc) {
+        arr.splice(tc, from, offset, count);
+        return arr;
+    }
 
     /* Associative operations. */
     public static SixModelObject atkey(SixModelObject hash, String key, ThreadContext tc) {

diff --git a/t/qast_aggregate.t b/t/qast_aggregate.t
@@ -1,6 +1,6 @@
 use helper;
 
-plan(9);
+plan(12);
 
 qast_test(
     -> {
@@ -485,3 +485,123 @@ qast_test(
     },
     "1\n1125\n0\n",
     "Hash iteration");
+
+qast_test(
+    -> {
+        my $block := QAST::Block.new(
+            QAST::Op.new(
+                :op('bind'),
+                QAST::Var.new( :name('l'), :scope('local'), :decl('var') ),
+                QAST::Op.new(
+                    :op('list'),
+                    QAST::Op.new( :op('list') ),
+                    QAST::Op.new( :op('list') )
+                )),
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('elems'),
+                    QAST::Var.new( :name('l'), :scope('local') )
+                )),
+            QAST::Op.new(
+                :op('splice'),
+                QAST::Var.new( :name('l'), :scope('local') ),
+                QAST::Var.new( :name('l'), :scope('local') ),
+                QAST::IVal.new( :value(2) ),
+                QAST::IVal.new( :value(0) )),
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('elems'),
+                    QAST::Var.new( :name('l'), :scope('local') )
+                ))
+        );
+        QAST::CompUnit.new(
+            $block,
+            :main(QAST::Op.new(
+                :op('call'),
+                QAST::BVal.new( :value($block) )
+            )))
+    },
+    "2\n4\n",
+    "Splice has the right elems");
+
+qast_test(
+    -> {
+        my $block := QAST::Block.new(
+            QAST::Op.new(
+                :op('bind'),
+                QAST::Var.new( :name('l'), :scope('local'), :decl('var') ),
+                QAST::Op.new(
+                    :op('list'),
+                    QAST::Op.new( :op('list') ),
+                    QAST::Op.new( :op('list') )
+                )),
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('elems'),
+                    QAST::Var.new( :name('l'), :scope('local') )
+                )),
+            QAST::Op.new(
+                :op('splice'),
+                QAST::Var.new( :name('l'), :scope('local') ),
+                QAST::Var.new( :name('l'), :scope('local') ),
+                QAST::IVal.new( :value(2) ),
+                QAST::IVal.new( :value(2) )),
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('elems'),
+                    QAST::Var.new( :name('l'), :scope('local') )
+                ))
+        );
+        QAST::CompUnit.new(
+            $block,
+            :main(QAST::Op.new(
+                :op('call'),
+                QAST::BVal.new( :value($block) )
+            )))
+    },
+    "2\n4\n",
+    "Splice has the right elems at the end");
+
+qast_test(
+    -> {
+        my $block := QAST::Block.new(
+            QAST::Op.new(
+                :op('bind'),
+                QAST::Var.new( :name('l'), :scope('local'), :decl('var') ),
+                QAST::Op.new(
+                    :op('list'),
+                    QAST::Op.new( :op('list') ),
+                    QAST::Op.new( :op('list') )
+                )),
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('elems'),
+                    QAST::Var.new( :name('l'), :scope('local') )
+                )),
+            QAST::Op.new(
+                :op('splice'),
+                QAST::Var.new( :name('l'), :scope('local') ),
+                QAST::Var.new( :name('l'), :scope('local') ),
+                QAST::IVal.new( :value(0) ),
+                QAST::IVal.new( :value(2) )),
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('elems'),
+                    QAST::Var.new( :name('l'), :scope('local') )
+                ))
+        );
+        QAST::CompUnit.new(
+            $block,
+            :main(QAST::Op.new(
+                :op('call'),
+                QAST::BVal.new( :value($block) )
+            )))
+    },
+    "2\n2\n",
+    "Splice has the right elems replacing two");