Add stableSort, stableSortInPlace from Belt to Array

Author: cknitt

src/Core__Array.mjs

@@ -112,8 +112,105 @@ function flatMap(a, f) {
   return Caml_splice_call.spliceObjApply([], "concat", [a.map(f)]);
 }
 
+function blitUnsafe(a1, srcofs1, a2, srcofs2, blitLength) {
+  if (srcofs2 <= srcofs1) {
+    for(var j = 0; j < blitLength; ++j){
+      a2[j + srcofs2 | 0] = a1[j + srcofs1 | 0];
+    }
+    return ;
+  }
+  for(var j$1 = blitLength - 1 | 0; j$1 >= 0; --j$1){
+    a2[j$1 + srcofs2 | 0] = a1[j$1 + srcofs1 | 0];
+  }
+}
+
+function merge(src, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs, cmp) {
+  var src1r = src1ofs + src1len | 0;
+  var src2r = src2ofs + src2len | 0;
+  var _i1 = src1ofs;
+  var _s1 = src[src1ofs];
+  var _i2 = src2ofs;
+  var _s2 = src2[src2ofs];
+  var _d = dstofs;
+  while(true) {
+    var d = _d;
+    var s2 = _s2;
+    var i2 = _i2;
+    var s1 = _s1;
+    var i1 = _i1;
+    if (cmp(s1, s2) <= 0) {
+      dst[d] = s1;
+      var i1$1 = i1 + 1 | 0;
+      if (i1$1 >= src1r) {
+        return blitUnsafe(src2, i2, dst, d + 1 | 0, src2r - i2 | 0);
+      }
+      _d = d + 1 | 0;
+      _s1 = src[i1$1];
+      _i1 = i1$1;
+      continue ;
+    }
+    dst[d] = s2;
+    var i2$1 = i2 + 1 | 0;
+    if (i2$1 >= src2r) {
+      return blitUnsafe(src, i1, dst, d + 1 | 0, src1r - i1 | 0);
+    }
+    _d = d + 1 | 0;
+    _s2 = src2[i2$1];
+    _i2 = i2$1;
+    continue ;
+  };
+}
+
+function insertionSort(src, srcofs, dst, dstofs, len, cmp) {
+  for(var i = 0; i < len; ++i){
+    var e = src[srcofs + i | 0];
+    var j = (dstofs + i | 0) - 1 | 0;
+    while(j >= dstofs && cmp(dst[j], e) > 0) {
+      dst[j + 1 | 0] = dst[j];
+      j = j - 1 | 0;
+    };
+    dst[j + 1 | 0] = e;
+  }
+}
+
+function sortTo(src, srcofs, dst, dstofs, len, cmp) {
+  if (len <= 5) {
+    return insertionSort(src, srcofs, dst, dstofs, len, cmp);
+  }
+  var l1 = len / 2 | 0;
+  var l2 = len - l1 | 0;
+  sortTo(src, srcofs + l1 | 0, dst, dstofs + l1 | 0, l2, cmp);
+  sortTo(src, srcofs, src, srcofs + l2 | 0, l1, cmp);
+  merge(src, srcofs + l2 | 0, l1, dst, dstofs + l1 | 0, l2, dst, dstofs, cmp);
+}
+
+function stableSortInPlaceU(a, cmp) {
+  var l = a.length;
+  if (l <= 5) {
+    return insertionSort(a, 0, a, 0, l, cmp);
+  }
+  var l1 = l / 2 | 0;
+  var l2 = l - l1 | 0;
+  var t = new Array(l2);
+  sortTo(a, l1, t, 0, l2, cmp);
+  sortTo(a, 0, a, l2, l1, cmp);
+  merge(a, l2, l1, t, 0, l2, a, 0, cmp);
+}
+
+function stableSortInPlace(a, cmp) {
+  stableSortInPlaceU(a, Curry.__2(cmp));
+}
+
+function stableSort(a, cmp) {
+  var b = a.slice();
+  stableSortInPlaceU(b, Curry.__2(cmp));
+  return b;
+}
+
 export {
   sort ,
+  stableSort ,
+  stableSortInPlace ,
   indexOfOpt ,
   lastIndexOfOpt ,
   reduce ,

src/Core__Array.res

@@ -202,3 +202,95 @@ let filterMap = (a, f) => filterMapU(a, (. a) => f(a))
 
 // TODO: Change this implementation?
 let flatMap = (a, f) => []->concatMany(map(a, f))
+
+module SortArray = {
+  @new external makeUninitializedUnsafe: int => array<'a> = "Array"
+
+  let cutoff = 5
+
+  let blitUnsafe = (
+    ~src as a1,
+    ~srcOffset as srcofs1,
+    ~dst as a2,
+    ~dstOffset as srcofs2,
+    ~len as blitLength,
+  ) =>
+    if srcofs2 <= srcofs1 {
+      for j in 0 to blitLength - 1 {
+        a2->setUnsafe(j + srcofs2, a1->getUnsafe(j + srcofs1))
+      }
+    } else {
+      for j in blitLength - 1 downto 0 {
+        a2->setUnsafe(j + srcofs2, a1->getUnsafe(j + srcofs1))
+      }
+    }
+
+  let merge = (src, src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs, cmp) => {
+    let src1r = src1ofs + src1len and src2r = src2ofs + src2len
+    let rec loop = (i1, s1, i2, s2, d) =>
+      if cmp(. s1, s2) <= 0 {
+        setUnsafe(dst, d, s1)
+        let i1 = i1 + 1
+        if i1 < src1r {
+          loop(i1, getUnsafe(src, i1), i2, s2, d + 1)
+        } else {
+          blitUnsafe(~src=src2, ~srcOffset=i2, ~dst, ~dstOffset=d + 1, ~len=src2r - i2)
+        }
+      } else {
+        setUnsafe(dst, d, s2)
+        let i2 = i2 + 1
+        if i2 < src2r {
+          loop(i1, s1, i2, getUnsafe(src2, i2), d + 1)
+        } else {
+          blitUnsafe(~src, ~srcOffset=i1, ~dst, ~dstOffset=d + 1, ~len=src1r - i1)
+        }
+      }
+
+    loop(src1ofs, getUnsafe(src, src1ofs), src2ofs, getUnsafe(src2, src2ofs), dstofs)
+  }
+
+  /* `<=` alone is not enough for stable sort */
+  let insertionSort = (src, srcofs, dst, dstofs, len, cmp) =>
+    for i in 0 to len - 1 {
+      let e = getUnsafe(src, srcofs + i)
+      let j = ref(dstofs + i - 1)
+      while j.contents >= dstofs && cmp(. getUnsafe(dst, j.contents), e) > 0 {
+        setUnsafe(dst, j.contents + 1, getUnsafe(dst, j.contents))
+        j.contents = j.contents - 1
+      }
+      setUnsafe(dst, j.contents + 1, e)
+    }
+
+  let rec sortTo = (src, srcofs, dst, dstofs, len, cmp) =>
+    if len <= cutoff {
+      insertionSort(src, srcofs, dst, dstofs, len, cmp)
+    } else {
+      let l1 = len / 2
+      let l2 = len - l1
+      sortTo(src, srcofs + l1, dst, dstofs + l1, l2, cmp)
+      sortTo(src, srcofs, src, srcofs + l2, l1, cmp)
+      merge(src, srcofs + l2, l1, dst, dstofs + l1, l2, dst, dstofs, cmp)
+    }
+
+  let stableSortInPlaceU = (a, cmp) => {
+    let l = length(a)
+    if l <= cutoff {
+      insertionSort(a, 0, a, 0, l, cmp)
+    } else {
+      let l1 = l / 2
+      let l2 = l - l1
+      let t = makeUninitializedUnsafe(l2)
+      sortTo(a, l1, t, 0, l2, cmp)
+      sortTo(a, 0, a, l2, l1, cmp)
+      merge(a, l2, l1, t, 0, l2, a, 0, cmp)
+    }
+  }
+}
+
+let stableSortInPlace = (a, cmp) => SortArray.stableSortInPlaceU(a, (. x, y) => cmp(x, y))
+
+let stableSort = (a, cmp) => {
+  let b = copy(a)
+  SortArray.stableSortInPlaceU(b, (. x, y) => cmp(x, y))
+  b
+}

src/Core__Array.resi

@@ -22,6 +22,8 @@ external copyWithin: (array<'a>, ~target: int, ~start: int, ~end: int) => array<
 @send external shift: array<'a> => option<'a> = "shift"
 let sort: (array<'a>, ('a, 'a) => int) => array<'a>
 @send external sortInPlace: (array<'a>, ('a, 'a) => int) => unit = "sort"
+let stableSort: (array<'a>, ('a, 'a) => int) => array<'a>
+let stableSortInPlace: (array<'a>, ('a, 'a) => int) => unit
 @variadic @send
 external spliceInPlace: (array<'a>, ~start: int, ~remove: int, ~insert: array<'a>) => unit =
   "splice"

src/Core__List.mjs

@@ -4,7 +4,6 @@ import * as Curry from "rescript/lib/es6/curry.js";
 import * as Belt_Array from "rescript/lib/es6/belt_Array.js";
 import * as Caml_option from "rescript/lib/es6/caml_option.js";
 import * as Core__Array from "./Core__Array.mjs";
-import * as Belt_SortArray from "rescript/lib/es6/belt_SortArray.js";
 
 function head(x) {
   if (x) {
@@ -1177,9 +1176,8 @@ function setAssoc(xs, x, k, eq) {
 }
 
 function sort(xs, cmp) {
-  var cmp$1 = Curry.__2(cmp);
   var arr = toArray(xs);
-  Belt_SortArray.stableSortInPlaceByU(arr, cmp$1);
+  Core__Array.stableSortInPlace(arr, cmp);
   return fromArray(arr);
 }
 

src/Core__List.res

@@ -793,14 +793,12 @@ let setAssocU = (xs, x, k, eq) =>
 
 let setAssoc = (xs, x, k, eq) => setAssocU(xs, x, k, (. a, b) => eq(a, b))
 
-let sortU = (xs, cmp) => {
+let sort = (xs, cmp) => {
   let arr = toArray(xs)
-  Belt_SortArray.stableSortInPlaceByU(arr, cmp)
+  Core__Array.stableSortInPlace(arr, cmp)
   fromArray(arr)
 }
 
-let sort = (xs, cmp) => sortU(xs, (. x, y) => cmp(x, y))
-
 let rec getByU = (xs, p) =>
   switch xs {
   | list{} => None