First pass at making sort work on Rakudo JVM.

rakudo · Jun 21, 2013 · d058373 · d058373
1 parent 49f1113
commit d058373
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 2 deletions.
diff --git a/src/core/List.pm b/src/core/List.pm
@@ -280,11 +280,11 @@ my class List does Positional {
         # for sorting.
         if ($by.?count // 2) < 2 {
             my $list = self.map($by).eager;
-            $index_rpa.sort(-> $a, $b { $list[$a] cmp $list[$b] || $a <=> $b });
+            nqp::p6sort($index_rpa, -> $a, $b { $list[$a] cmp $list[$b] || $a <=> $b });
         }
         else {
             my $list = self.eager;
-            $index_rpa.sort(-> $a, $b { $by($list[$a],$list[$b]) || $a <=> $b });
+            nqp::p6sort($index_rpa, -> $a, $b { $by($list[$a],$list[$b]) || $a <=> $b });
         }
         self[$index];
     }

diff --git a/src/vm/jvm/Perl6/Ops.nqp b/src/vm/jvm/Perl6/Ops.nqp
@@ -88,6 +88,7 @@ $ops.map_classlib_hll_op('perl6', 'p6arrfindtypes', $TYPE_P6OPS, 'p6arrfindtypes
 $ops.map_classlib_hll_op('perl6', 'p6decodelocaltime', $TYPE_P6OPS, 'p6decodelocaltime', [$RT_INT], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'p6setautothreader', $TYPE_P6OPS, 'p6setautothreader', [$RT_OBJ], $RT_OBJ, :tc);
 $ops.map_classlib_hll_op('perl6', 'tclc', $TYPE_P6OPS, 'tclc', [$RT_STR], $RT_STR, :tc);
+$ops.map_classlib_hll_op('perl6', 'p6sort', $TYPE_P6OPS, 'p6sort', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
 $ops.add_hll_op('perl6', 'p6getcallsig', -> $qastcomp, $op {
     $qastcomp.as_jast(QAST::Op.new( :op('usecapture') ))
 });

diff --git a/src/vm/jvm/runtime/org/perl6/rakudo/Ops.java b/src/vm/jvm/runtime/org/perl6/rakudo/Ops.java
@@ -1,5 +1,7 @@
 package org.perl6.rakudo;
 
+import java.util.Arrays;
+import java.util.Comparator;
 import org.perl6.nqp.runtime.*;
 import org.perl6.nqp.sixmodel.*;
 import org.perl6.nqp.sixmodel.reprs.LexoticInstance;
@@ -509,4 +511,23 @@ public static String tclc(String in, ThreadContext tc) {
         return new String(Character.toChars(Character.toTitleCase(first)))
             + in.substring(Character.charCount(first)).toLowerCase();
     }
+
+    private static final CallSiteDescriptor SortCSD = new CallSiteDescriptor(
+        new byte[] { CallSiteDescriptor.ARG_OBJ, CallSiteDescriptor.ARG_OBJ }, null);
+    public static SixModelObject p6sort(SixModelObject indices, final SixModelObject comparator, final ThreadContext tc) {
+        int elems = (int)indices.elems(tc);
+        SixModelObject[] sortable = new SixModelObject[elems];
+        for (int i = 0; i < elems; i++)
+            sortable[i] = indices.at_pos_boxed(tc, i);
+        Arrays.sort(sortable, new Comparator<SixModelObject>() {
+            public int compare(SixModelObject a, SixModelObject b) {
+                org.perl6.nqp.runtime.Ops.invokeDirect(tc, comparator, SortCSD,
+                    new Object[] { a, b });
+                return (int)org.perl6.nqp.runtime.Ops.result_i(tc.curFrame);
+            }
+        });
+        for (int i = 0; i < elems; i++)
+            indices.bind_pos_boxed(tc, i, sortable[i]);
+        return indices;
+    }
 }
diff --git a/src/vm/parrot/Perl6/Ops.nqp b/src/vm/parrot/Perl6/Ops.nqp
@@ -46,6 +46,12 @@ $ops.add_hll_op('perl6', 'p6getcallsig', -> $qastcomp, $op {
     $ops.push_pirop('set', $reg, 'CALL_SIG');
     $ops
 });
+$ops.add_hll_op('perl6', 'p6sort', -> $qastcomp, $op {
+    $qastcomp.as_post(QAST::Op.new(
+        :op('callmethod'), :name('sort'),
+        $op[0], $op[1]
+    ))
+});
 my $p6bool := -> $qastcomp, $op {
     my $cpost := $qastcomp.as_post($op[0]);
     my $reg := $*REGALLOC.fresh_p();