Merge 7bb2898 into 2f7fb3f

jscomp/others/.depend

@@ -17,9 +17,10 @@ js_console.cmj :
 js_result.cmj : js_result.cmi
 js_mapperRt.cmj : js_mapperRt.cmi
 bs_Array.cmj : js_math.cmj bs_Array.cmi
-bs_internalAVLset.cmj : bs_Array.cmj bs.cmj bs_internalAVLset.cmi
+bs_internalAVLset.cmj : bs_Cmp.cmj bs_Array.cmj bs_internalAVLset.cmi
 bs_internalAVLtree.cmj : bs_internalAVLtree.cmi
-bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetIntM.cmi
+bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_Array.cmj \
+    bs_SetIntM.cmi
 bs_Hash.cmj : bs_Hash.cmi
 bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi
 bs_List.cmj : js_json.cmj bs_Array.cmj bs_List.cmi
@@ -45,20 +46,20 @@ bs_Map.cmj : bs_internalAVLtree.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \
     bs_Map.cmi
 bs_MapString.cmj : bs_internalAVLtree.cmj bs_Array.cmj bs_MapString.cmi
 bs_MapInt.cmj : bs_internalAVLtree.cmj bs_Array.cmj bs_MapInt.cmi
-bs_internalSet.cmj : bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj \
-    bs_Array.cmj
-bs_Set.cmj : bs_internalSet.cmj bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj \
+bs_internalSet.cmj : bs_internalSet.cmi
+bs_Set.cmj : bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \
     bs_Set.cmi
-bs_SetM.cmj : bs_internalSet.cmj bs_internalAVLset.cmj bs_Cmp.cmj \
-    bs_BagM.cmj bs_SetM.cmi
+bs_SetM.cmj : bs_internalAVLset.cmj bs_Sort.cmj bs_Cmp.cmj bs_BagM.cmj \
+    bs_Array.cmj bs_SetM.cmi
 bs_internalSetInt.cmj : bs_internalAVLset.cmj bs_Array.cmj
 bs_internalSetString.cmj : bs_internalAVLset.cmj bs_Array.cmj
 bs_SetInt.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetInt.cmi
-bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetIntM.cmi
+bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_Array.cmj \
+    bs_SetIntM.cmi
 bs_SetString.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \
     bs_SetString.cmi
 bs_SetStringM.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \
-    bs_SetStringM.cmi
+    bs_Array.cmj bs_SetStringM.cmi
 bs_Stack.cmj : bs_Stack.cmi
 node_child_process.cmj : node.cmj
 js_boolean.cmj : js_boolean.cmi
@@ -83,7 +84,7 @@ js_option.cmi :
 js_result.cmi :
 js_mapperRt.cmi :
 bs_Array.cmi :
-bs_internalAVLset.cmi :
+bs_internalAVLset.cmi : bs_Cmp.cmi
 bs_internalAVLtree.cmi :
 bs_SetIntM.cmi :
 bs_Hash.cmi :
@@ -99,6 +100,7 @@ bs_Cmp.cmi :
 bs_Map.cmi : bs_Cmp.cmi bs_Bag.cmj
 bs_MapString.cmi :
 bs_MapInt.cmi :
+bs_internalSet.cmi :
 bs_Set.cmi : bs_Cmp.cmi bs_Bag.cmj
 bs_SetM.cmi : bs_Cmp.cmi
 bs_SetInt.cmi :

jscomp/others/bs_Set.ml

@@ -1,40 +1,201 @@
 
 module N = Bs_internalAVLset
-module I = Bs_internalSet
 module B = Bs_Bag 
-type ('k,'id) t0 = ('k,'id) I.t0
+module A = Bs_Array
+
+type ('k,'id) t0 = 'k N.t0
 type ('elt,'id) t = (('elt,'id) Bs_Cmp.t , ('elt,'id) t0) B.bag  
 
+(* here we relies on reference transparence
+   address equality means everything equal across time
+   no need to call [bal] again
+*)  
+let rec add0 ~cmp (t : _ t0) x  : _ t0 =
+  match N.toOpt t with 
+    None -> N.singleton0 x 
+  | Some nt ->
+    let k = N.key nt in 
+    let c = (Bs_Cmp.getCmp cmp) x k [@bs] in
+    if c = 0 then t else
+      let l,r = N.(left nt, right nt) in 
+      if c < 0 then 
+        let ll = add0 ~cmp l x in 
+        if ll == l then t 
+        else N.bal ll k r 
+      else 
+        let rr = add0 ~cmp r x in 
+        if rr == r then t 
+        else N.bal l k rr 
+
+let rec remove0 ~cmp (t : _ t0) x : _ t0 = 
+  match N.toOpt t with 
+    None -> t
+  | Some n  ->
+    let l,v,r = N.(left n , key n, right n) in 
+    let c = (Bs_Cmp.getCmp cmp) x v [@bs] in
+    if c = 0 then 
+      match N.toOpt l, N.toOpt r with 
+      | (None, _) -> r 
+      | (_, None) -> l 
+      | (_, Some rn) -> 
+        let v = ref (N.key rn) in 
+        let r = N.removeMinAuxWithRef rn v in 
+        N.bal l !v r 
+    else
+    if c < 0 then 
+      let ll = remove0 ~cmp  l x in 
+      if ll == l then t
+      else N.bal ll v r 
+    else
+      let rr = remove0 ~cmp  r x in 
+      if rr == r then t  
+      else N.bal l v rr
+
+let addArray0   h arr ~cmp =   
+  let len = A.length arr in 
+  let v = ref h in  
+  for i = 0 to len - 1 do 
+    let key = A.unsafe_get arr i in 
+    v := add0 !v  ~cmp key 
+  done ;
+  !v 
+
+let removeArray0 h arr ~cmp = 
+  let len = A.length arr in 
+  let v = ref h in  
+  for i = 0 to len - 1 do 
+    let key = A.unsafe_get arr i in 
+    v := remove0 !v  ~cmp key 
+  done ;
+  !v 
+
+let rec splitAuxNoPivot ~cmp (n : _ N.node) x : _ *  _ =   
+  let l,v,r = N.(left n , key n, right n) in  
+  let c = (Bs_Cmp.getCmp cmp) x v [@bs] in
+  if c = 0 then l,r
+  else 
+  if c < 0 then
+    match N.toOpt l with 
+    | None -> 
+      N.empty ,  N.return n
+    | Some l -> 
+      let (ll,  rl) = splitAuxNoPivot ~cmp  l x in 
+      ll,  N.joinShared rl v r
+  else
+    match N.toOpt r with 
+    | None ->
+      N.return n,  N.empty
+    | Some r -> 
+      let lr,  rr = splitAuxNoPivot ~cmp  r x in 
+      N.joinShared l v lr, rr
+
+let rec splitAuxPivot ~cmp (n : _ N.node) x pres : _ *  _ =   
+  let l,v,r = N.(left n , key n, right n) in  
+  let c = (Bs_Cmp.getCmp cmp) x v [@bs] in
+  if c = 0 then 
+    begin
+      pres := true;
+      l, r
+    end
+  else 
+  if c < 0 then
+    match N.toOpt l with 
+    | None -> 
+      N.empty , N.return n
+    | Some l -> 
+      let (ll, rl) = splitAuxPivot ~cmp  l x pres in 
+      ll,  N.joinShared rl v r
+  else
+    match N.toOpt r with 
+    | None ->
+      N.return n,  N.empty
+    | Some r -> 
+      let lr, rr = splitAuxPivot ~cmp  r x pres in 
+      N.joinShared l v lr,  rr
+
+let  split0 ~cmp  (t : _ t0) x  =
+  match N.toOpt t with 
+    None ->
+    (N.empty, N.empty), false
+  | Some n ->
+    let pres = ref false in 
+    let v = splitAuxPivot ~cmp n x  pres in 
+    v, !pres
+
+(* [union0 s1 s2]
+   Use the pivot to split the smaller collection
+*)      
+let rec union0 ~cmp (s1 : _ t0) (s2 : _ t0) : _ t0=
+  match N.(toOpt s1, toOpt s2) with
+    (None, _) -> s2
+  | (_, None) -> s1
+  | Some n1, Some n2 ->
+    let h1, h2 = N.(h n1 , h n2) in                 
+    if h1 >= h2 then
+      if h2 = 1 then add0 ~cmp s1 (N.key n2)  
+      else begin
+        let l1, v1, r1 = N.(left n1, key n1, right n1) in      
+        let l2, r2 = splitAuxNoPivot ~cmp n2 v1 in
+        N.joinShared (union0 ~cmp l1 l2) v1 (union0 ~cmp r1 r2)
+      end
+    else
+    if h1 = 1 then add0 s2 ~cmp (N.key n1) 
+    else begin
+      let l2, v2, r2 = N.(left n2 , key n2, right n2) in 
+      let l1, r1 = splitAuxNoPivot ~cmp n1 v2  in
+      N.joinShared (union0 ~cmp l1 l2) v2 (union0 ~cmp r1 r2)
+    end
+
+let rec inter0 ~cmp (s1 : _ t0) (s2 : _ t0) =
+  match N.(toOpt s1, toOpt s2) with
+  | None, _ 
+  | _, None -> N.empty
+  | Some n1, Some n2  ->
+    let l1,v1,r1 = N.(left n1, key n1, right n1) in  
+    let pres = ref false in 
+    let l2,r2 = splitAuxPivot ~cmp n2 v1 pres in 
+    let ll = inter0 ~cmp l1 l2 in 
+    let rr = inter0 ~cmp r1 r2 in 
+    if !pres then N.joinShared ll v1 rr 
+    else N.concatShared ll rr 
+
+let rec diff0 ~cmp s1 s2 =
+  match N.(toOpt s1, toOpt s2) with
+    (None, _) 
+  | (_, None) -> s1
+  | Some n1, Some n2  ->
+    let l1,v1,r1 = N.(left n1, key n1, right n1) in
+    let pres = ref false in 
+    let l2, r2 = splitAuxPivot ~cmp n2 v1 pres in 
+    let ll = diff0 ~cmp l1 l2 in 
+    let rr = diff0 ~cmp r1 r2 in 
+    if !pres then N.concatShared ll rr 
+    else N.joinShared ll v1 rr 
+
+
+
 let empty0 = N.empty0      
-let ofArray0 = I.ofArray0
+let ofArray0 = N.ofArray0
 let isEmpty0 = N.isEmpty0
-let mem0 = I.mem0
-let add0 = I.add0
-let addArray0 = I.addArrayMutate
+let mem0 = N.mem0
 let singleton0 = N.singleton0
-let remove0 = I.remove0
-let removeArray0 = I.removeArray0
-let union0 = I.union0 
-let inter0 = I.inter0
-let diff0 = I.diff0
-let subset0 = I.subset0
-let cmp0 = I.cmp0
-let eq0 = I.eq0 
+let subset0 = N.subset0
+let cmp0 = N.cmp0
+let eq0 = N.eq0 
 let iter0 = N.iter0      
 let fold0 = N.fold0
 let forAll0 = N.forAll0
 let exists0 = N.exists0    
-let filter0 = N.filter0
-let partition0 = N.partition0
+let filter0 = N.filterShared0
+let partition0 = N.partitionShared0
 let length0 = N.length0
 let toList0 = N.toList0
 let toArray0 = N.toArray0
 let minOpt0 = N.minOpt0
 let maxOpt0 = N.maxOpt0
-let split0 = I.split0
 let ofSortedArrayUnsafe0 = N.ofSortedArrayUnsafe0
-let findOpt0 = I.findOpt0
-let findNull0 = I.findNull0
+let findOpt0 = N.findOpt0
+let findNull0 = N.findNull0
 
 let empty dict = 
   B.bag
@@ -68,14 +229,14 @@ let add (type elt) (type id) (m : (elt,id) t) e =
 let addArray (type elt) (type id) (m : (elt,id) t) e = 
   let dict, data = B.(dict m, data m) in 
   let module M = (val dict) in 
-  let newData = I.addArray0 ~cmp:M.cmp data e in 
+  let newData = addArray0 ~cmp:M.cmp data e in 
   if newData == data then m
   else B.bag ~dict ~data:newData
 
 let removeArray (type elt) (type id) (m : (elt,id) t) e = 
   let dict, data = B.(dict m, data m) in 
   let module M = (val dict) in 
-  let newData = I.removeArray0 ~cmp:M.cmp data e in 
+  let newData = removeArray0 ~cmp:M.cmp data e in 
   if newData == data then m
   else B.bag ~dict ~data:newData
 
@@ -136,11 +297,11 @@ let exists m f = N.exists0  (B.data m) f
 
 let filter m f  = 
   let data, dict = B.(data m, dict m) in 
-  B.bag ~dict ~data:(N.filter0 data f )
+  B.bag ~dict ~data:(N.filterShared0 data f )
 
 let partition m f  = 
   let mdata, dict = B.(data m, dict m) in   
-  let l,r = N.partition0 mdata f in   
+  let l,r = N.partitionShared0 mdata f in   
   B.bag ~data:l ~dict, B.bag ~data:r ~dict
 
 let length m = N.length0 (B.data m) 
@@ -156,10 +317,11 @@ let maxNull m = N.maxNull0 (B.data m)
 let split (type elt) (type id) (m : (elt,id) t) e = 
   let dict, data = B.(dict m, data m) in  
   let module M = (val dict) in 
-  let l, b, r = split0 ~cmp:M.cmp data e in 
-  B.bag ~dict ~data:l,
-  b,
-  B.bag ~dict ~data:r
+  let (l,  r), b = split0 ~cmp:M.cmp data e in 
+  (B.bag ~dict ~data:l,
+  B.bag ~dict ~data:r),
+  b
+
 
 let findOpt (type elt) (type id)  (m : (elt,id) t) e =   
   let dict, data = B.(dict m, data m) in   
@@ -169,7 +331,7 @@ let findOpt (type elt) (type id)  (m : (elt,id) t) e =
 let findNull (type elt) (type id) (m : (elt,id) t) e =   
   let dict, data = B.(dict m, data m) in 
   let module M = (val dict) in 
-  I.findNull0 ~cmp:M.cmp data e
+  N.findNull0 ~cmp:M.cmp data e
 
 
 let ofSortedArrayUnsafe ~dict xs  =

jscomp/others/bs_Set.mli

@@ -84,14 +84,8 @@ val maxOpt: ('elt, 'id) t -> 'elt option
 val maxNull: ('elt, 'id) t -> 'elt Js.null
 
 val split: 
-  ('elt, 'id) t -> 'elt -> ('elt, 'id) t * bool * ('elt, 'id) t
-(** [split x s] returns a triple [(l, present, r)], where
-      [l] is the set of elements of [s] that are
-      strictly less than [x];
-      [r] is the set of elements of [s] that are
-      strictly greater than [x];
-      [present] is [false] if [s] contains no element equal to [x],
-      or [true] if [s] contains an element equal to [x]. *)
+  ('elt, 'id) t -> 'elt -> 
+  (('elt, 'id) t  * ('elt, 'id) t) * bool
 
 val ofSortedArrayUnsafe:
   dict:('elt, 'id) Bs_Cmp.t ->
@@ -178,7 +172,8 @@ val maxOpt0: ('elt, 'id) t0 -> 'elt option
 
 val split0: 
   cmp: ('elt,'id) Bs_Cmp.cmp ->
-  ('elt, 'id) t0 -> 'elt -> ('elt, 'id) t0 * bool * ('elt, 'id) t0
+  ('elt, 'id) t0 -> 'elt -> 
+  (('elt, 'id) t0  * ('elt, 'id) t0) * bool
 
 val ofSortedArrayUnsafe0:
   'elt array -> ('elt,'id) t0

jscomp/others/bs_SetInt.ml

@@ -19,8 +19,8 @@ let iter = N.iter0
 let fold = N.fold0
 let forAll = N.forAll0
 let exists = N.exists0    
-let filter = N.filter0
-let partition = N.partition0
+let filter = N.filterShared0
+let partition = N.partitionShared0
 let length = N.length0
 let toList = N.toList0
 let toArray = N.toArray0
@@ -39,3 +39,4 @@ let inter = I.inter
 let union = I.union
 let remove = I.remove 
 let mem = I.mem 
+

jscomp/others/bs_SetInt.mli

@@ -68,7 +68,7 @@ val maxOpt: t -> elt option
 val maxNull: t -> elt Js.null
 
 
-val split:  t -> elt -> t * bool * t
+val split:  t -> elt -> (t * t) * bool  
 (** [split x s] returns a triple [(l, present, r)], where
       [l] is the set of elements of [s] that are
       strictly less than [x];