add diff union inter for sorted array

jscomp/others/bs_Array.ml

@@ -196,4 +196,9 @@ let forAll2  a b p =
   let lenb = length b in 
   if lena <> lenb then false
   else 
-    forAllAux2  a b 0 p lena
+    forAllAux2  a b 0 p lena
+
+external truncateToLengthUnsafe : 'a array -> int ->  unit = "length" [@@bs.set]
+
+
+

jscomp/others/bs_Array.mli

@@ -108,3 +108,4 @@ val forAll2: 'a array -> 'b array -> ('a -> 'b -> bool [@bs]) -> bool
 
 external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get"
 external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set"
+external truncateToLengthUnsafe : 'a array -> int ->  unit = "length" [@@bs.set]

jscomp/others/bs_Sort.ml

@@ -63,9 +63,131 @@ let merge src src1ofs src1len src2 src2ofs src2len dst dstofs cmp =
   in 
   loop src1ofs (A.unsafe_get src src1ofs) src2ofs (A.unsafe_get src2 src2ofs) dstofs
 
+let union src src1ofs src1len src2 src2ofs src2len dst dstofs cmp =
+  let src1r = src1ofs + src1len in 
+  let src2r = src2ofs + src2len in
+  let rec loop i1 s1 i2 s2 d =
+    let c = cmp s1 s2 [@bs] in 
+    if c < 0 then begin
+      (* [s1] is larger than all elements in [d] *)
+      A.unsafe_set dst d s1; 
+      let i1 = i1 + 1 in
+      let d = d + 1 in 
+      if i1 < src1r then
+        loop i1 (A.unsafe_get src i1) i2 s2 d
+      else
+        begin 
+          A.blitUnsafe src2 i2 dst d (src2r - i2);
+          d + src2r - i2   
+        end
+    end 
+    else if c = 0 then begin 
+      A.unsafe_set dst d s1;
+      let i1 = i1 + 1 in
+      let i2 = i2 + 1 in 
+      let d  = d + 1 in 
+      if i1 < src1r && i2 < src1r then 
+        loop i1 (A.unsafe_get src i1) i2 (A.unsafe_get src2 i2) d
+      else if i1 = src1r then   
+        (A.blitUnsafe src2 i2 dst d (src2r - i2);
+         d + src2r - i2)
+      else    
+        (A.blitUnsafe src i1 dst d (src1r - i1);
+         d + src1r - i1)
+    end 
+    else begin
+      A.unsafe_set dst d s2;
+      let i2 = i2 + 1 in
+      let d = d + 1 in 
+      if i2 < src2r then
+        loop i1 s1 i2 (A.unsafe_get src2 i2) d
+      else
+        (A.blitUnsafe src i1 dst d (src1r - i1);
+         d + src1r - i1
+        )
+    end
+  in 
+  loop src1ofs 
+    (A.unsafe_get src src1ofs) 
+    src2ofs 
+    (A.unsafe_get src2 src2ofs) dstofs
 
 
-
+let inter src src1ofs src1len src2 src2ofs src2len dst dstofs cmp =
+  let src1r = src1ofs + src1len in 
+  let src2r = src2ofs + src2len in
+  let rec loop i1 s1 i2 s2 d =
+    let c = cmp s1 s2 [@bs] in 
+    if c < 0 then begin
+      (* A.unsafe_set dst d s1; *)
+      let i1 = i1 + 1 in
+      if i1 < src1r then
+        loop i1 (A.unsafe_get src i1) i2 s2 d
+      else
+        d
+    end 
+    else if c = 0 then begin 
+      A.unsafe_set dst d s1;
+      let i1 = i1 + 1 in
+      let i2 = i2 + 1 in 
+      let d = d + 1 in 
+      if i1 < src1r && i2 < src1r then 
+        loop i1 (A.unsafe_get src i1) i2 (A.unsafe_get src2 i2) d
+      else d
+    end 
+    else begin
+      (* A.unsafe_set dst d s2; *)
+      let i2 = i2 + 1 in
+      if i2 < src2r then
+        loop i1 s1 i2 (A.unsafe_get src2 i2) d
+      else
+        d
+    end
+  in 
+  loop src1ofs 
+    (A.unsafe_get src src1ofs) 
+    src2ofs 
+    (A.unsafe_get src2 src2ofs) dstofs    
+
+let diff src src1ofs src1len src2 src2ofs src2len dst dstofs cmp =
+  let src1r = src1ofs + src1len in 
+  let src2r = src2ofs + src2len in
+  let rec loop i1 s1 i2 s2 d =
+    let c = cmp s1 s2 [@bs] in 
+    if c < 0 then begin
+      A.unsafe_set dst d s1;
+      let d = d + 1 in 
+      let i1 = i1 + 1 in      
+      if i1 < src1r then
+        loop i1 (A.unsafe_get src i1) i2 s2 d
+      else
+        d
+    end 
+    else if c = 0 then begin 
+      let i1 = i1 + 1 in
+      let i2 = i2 + 1 in 
+      if i1 < src1r && i2 < src1r then 
+        loop i1 (A.unsafe_get src i1) i2 (A.unsafe_get src2 i2) d
+      else if i1 = src1r then 
+        d
+      else 
+      (A.blitUnsafe src i1 dst d (src1r - i1);
+        d + src1r - i1)
+    end 
+    else begin
+      let i2 = i2 + 1 in
+      if i2 < src2r then
+        loop i1 s1 i2 (A.unsafe_get src2 i2) d
+      else
+        (A.blitUnsafe src i1 dst d (src1r - i1);
+        d + src1r - i1)        
+    end
+  in 
+  loop src1ofs 
+    (A.unsafe_get src src1ofs) 
+    src2ofs 
+    (A.unsafe_get src2 src2ofs) dstofs        
+
 (* [<=] alone is not enough for stable sort *)
 let insertionSort src srcofs dst dstofs len cmp =
   for i = 0 to len - 1 do
@@ -90,7 +212,7 @@ let rec sortTo src srcofs dst dstofs len cmp =
   end    
 
 
-  
+
 
 let stableSortBy  a cmp =
   let l = A.length a in
@@ -120,21 +242,21 @@ let sortByCont xs cmp =
   input (lo <= hi)
   [arr[lo] <= key <= arr[hi]] *)
 let rec binSearchAux arr lo hi key cmp = 
-  
-    let mid = (lo + hi)/2 in 
-    let midVal = A.unsafe_get arr mid in 
-    let c = cmp key midVal [@bs] in 
-    if c = 0 then mid 
-    else if c < 0 then  (*  a[lo] =< key < a[mid] <= a[hi] *)
-      if hi = mid then  
-        if cmp (A.unsafe_get arr lo) key [@bs] = 0 then lo
-        else - (hi + 1)
-      else binSearchAux arr lo mid key cmp 
-    else  (*  a[lo] =< a[mid] < key <= a[hi] *)
-      if lo = mid then 
-        if cmp (A.unsafe_get arr hi) key [@bs] = 0 then hi
-        else - (hi + 1)
-      else binSearchAux arr mid hi key cmp 
+
+  let mid = (lo + hi)/2 in 
+  let midVal = A.unsafe_get arr mid in 
+  let c = cmp key midVal [@bs] in 
+  if c = 0 then mid 
+  else if c < 0 then  (*  a[lo] =< key < a[mid] <= a[hi] *)
+    if hi = mid then  
+      if cmp (A.unsafe_get arr lo) key [@bs] = 0 then lo
+      else - (hi + 1)
+    else binSearchAux arr lo mid key cmp 
+  else  (*  a[lo] =< a[mid] < key <= a[hi] *)
+  if lo = mid then 
+    if cmp (A.unsafe_get arr hi) key [@bs] = 0 then hi
+    else - (hi + 1)
+  else binSearchAux arr mid hi key cmp 
 
 let binSearch sorted key cmp : int =  
   let len = A.length sorted in 
@@ -144,7 +266,7 @@ let binSearch sorted key cmp : int =
     let c = cmp key lo [@bs] in 
     if c < 0 then -1 
     else
-    let hi = A.unsafe_get sorted (len - 1) in 
-    let c2 = cmp key hi [@bs]in 
-    if c2 > 0 then - (len + 1)
-    else binSearchAux sorted 0 (len - 1) key cmp 
+      let hi = A.unsafe_get sorted (len - 1) in 
+      let c2 = cmp key hi [@bs]in 
+      if c2 > 0 then - (len + 1)
+      else binSearchAux sorted 0 (len - 1) key cmp 

jscomp/others/bs_Sort.mli

@@ -2,14 +2,49 @@
 
 
 val isSorted : 'a array -> ('a -> 'a -> int [@bs]) -> bool
-
+(** [isSorted arr cmp]  
+    returns true if array is increeasingly sorted 
+   , equal is okay 
+   for example 
+   {[
+     isSorted [|1;1;2;3;4|] intCmp = true
+   ]}
+*)
 
 val stableSortBy : 'a array -> ('a -> 'a -> int [@bs]) -> unit 
 
 external sortBy : 
   'a array -> ('a -> 'a -> int [@bs]) -> unit = 
   "sort" [@@bs.send]
 
+val union :   
+  'a array -> int -> int -> 
+  'a array -> int -> int -> 
+  'a array -> int -> ('a -> 'a -> int [@bs])
+  -> int
+(**
+  [union src src1ofs src1len src2 src2ofs src2len dst dstofs cmp]
+  assume [src] and [src2] is strictly sorted.
+  for equivalent elements, it is picked from [src]
+  also assume that [dst] is large enough to store all elements
+*)  
+
+val inter :   
+  'a array -> int -> int -> 
+  'a array -> int -> int -> 
+  'a array -> int -> ('a -> 'a -> int [@bs])
+  -> int
+(** [union src src1ofs src1len src2 src2ofs src2len dst dstofs cmp]   
+  return the [offset] in the output array
+*)
+
+val diff : 
+  'a array -> int -> int -> 
+  'a array -> int -> int -> 
+  'a array -> int -> ('a -> 'a -> int [@bs])
+  -> int
+
+
 val sortByCont :   
   'a array -> ('a -> 'a -> int [@bs]) -> 'a array
 

jscomp/test/.depend

@@ -115,8 +115,8 @@ bs_rest_test.cmj :
 bs_set_bench.cmj : ../others/bs.cmj
 bs_set_int_test.cmj : mt.cmj ../stdlib/list.cmj ../runtime/js.cmj \
     ../others/bs.cmj array_data_util.cmj ../stdlib/array.cmj
-bs_sort_test.cmj : mt.cmj ../others/bs_Range.cmj ../others/bs.cmj \
-    array_data_util.cmj
+bs_sort_test.cmj : mt.cmj ../others/bs_Range.cmj ../others/bs_Array.cmj \
+    ../others/bs.cmj array_data_util.cmj
 bs_splice_partial.cmj : ../runtime/js.cmj
 bs_stack_test.cmj : ../runtime/js.cmj ../others/bs.cmj
 bs_string_test.cmj : mt.cmj ../runtime/js.cmj