Merge 390ce36 into 9312d17

jscomp/others/.depend

@@ -26,8 +26,9 @@ bs_Queue.cmj : bs_Array.cmj bs_Queue.cmi
 bs_List.cmj : js_json.cmj bs_Array.cmj bs_List.cmi
 bs_Sort.cmj : bs_Array.cmj bs_Sort.cmi
 bs_Range.cmj :
-bs_internalBucketsType.cmj : bs_Array.cmj
-bs_internalSetBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj
+bs_internalBucketsType.cmj : bs_Array.cmj bs_internalBucketsType.cmi
+bs_internalSetBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj \
+    bs_internalSetBuckets.cmi
 bs_internalBuckets.cmj : bs_internalBucketsType.cmj bs_Array.cmj bs.cmj
 bs_HashMap.cmj : bs_internalBucketsType.cmj bs_internalBuckets.cmj \
     bs_Hash.cmj bs_Bag.cmj bs_Array.cmj bs.cmj bs_HashMap.cmi
@@ -46,7 +47,6 @@ 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_internalSet.cmi
 bs_Set.cmj : bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \
     bs_Set.cmi
 bs_SetM.cmj : bs_internalAVLset.cmj bs_Sort.cmj bs_Cmp.cmj bs_BagM.cmj \
@@ -93,6 +93,8 @@ bs_Hash.cmi :
 bs_Queue.cmi :
 bs_List.cmi : js_json.cmi
 bs_Sort.cmi :
+bs_internalBucketsType.cmi :
+bs_internalSetBuckets.cmi : bs_internalBucketsType.cmi
 bs_HashMap.cmi : bs_Hash.cmi bs_Bag.cmj
 bs_HashMultiMap.cmi : bs_Hash.cmi bs_Bag.cmj
 bs_HashSet.cmi : bs_Hash.cmi bs_Bag.cmj
@@ -102,7 +104,6 @@ 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/Design.md

@@ -0,0 +1,39 @@
+
+
+
+
+hierachy
+
+# set 
+## bs_internalAVLset (basic module with rotation)
+
+  methods in this moudle could be shared  by (at least 2 of them)
+
+  fuctional set, functional specialized set
+  mutable set, mutable specialized set.
+
+  for example, [mem0] could be shared by functional/mutable poly set
+
+
+## bs_Set
+  functional poly set (depends on bs_internalAVLset)
+
+## intenral_set.cppo.ml
+## bs_intenralSetInt
+## bs_internalSetString
+
+  methods could be shared by funcitional/imperative specialized set.
+  This intermediate module is created since we want to share methods
+  like [findOpt], [cmp]
+
+## set.cppo.ml
+## bs_SetInt
+## bs_SetString
+
+
+
+## setm.cpp.ml
+## bs_SetIntM
+## bs_SetStringM
+
+# map 

jscomp/others/bs.ml

@@ -22,7 +22,7 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-(** Placeholder for BuckleScript data structures *)
+
 
 (**/*)
 (**/*)

jscomp/others/bs_HashMap.ml

@@ -15,6 +15,7 @@
 module N = Bs_internalBuckets 
 module C = Bs_internalBucketsType
 module B = Bs_Bag 
+module A = Bs_Array
 type ('a, 'b,'id) t0 = ('a,'b) N.t0 
 
 
@@ -47,8 +48,8 @@ let resize ~hash h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket ~hash ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_HashMapInt.ml

@@ -22,6 +22,7 @@ let hash (s : key) =
 (**  Adapted by Authors of BuckleScript 2017                           *)
 module N = Bs_internalBuckets
 module C = Bs_internalBucketsType
+module A = Bs_Array
 type ('a, 'b,'id) t0 = ('a,'b) N.t0 
 
 type 'b t = (key,'b,unit) t0
@@ -48,8 +49,8 @@ let resize  h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket  ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_HashMapString.ml

@@ -22,6 +22,7 @@ let hash (s : key) =
 (**  Adapted by Authors of BuckleScript 2017                           *)
 module N = Bs_internalBuckets
 module C = Bs_internalBucketsType
+module A = Bs_Array
 type ('a, 'b,'id) t0 = ('a,'b) N.t0 
 
 type 'b t = (key,'b,unit) t0
@@ -48,8 +49,8 @@ let resize  h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket  ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_HashMultiMap.ml

@@ -15,6 +15,7 @@
 module N = Bs_internalBuckets 
 module C = Bs_internalBucketsType
 module B = Bs_Bag 
+module A = Bs_Array
 type ('a, 'b,'id) t0 = ('a,'b) N.t0 
 
 type ('a,'b) bucket = ('a,'b) N.bucket
@@ -46,8 +47,8 @@ let resize ~hash h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket ~hash ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_HashSet.ml

@@ -26,6 +26,8 @@
 module N = Bs_internalSetBuckets
 module C = Bs_internalBucketsType
 module B = Bs_Bag 
+module A = Bs_Array
+
 type ('a,'id) t0 = 'a N.t0 
 
 
@@ -58,8 +60,8 @@ let resize ~hash h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket ~hash ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_HashSetInt.ml

@@ -9,6 +9,7 @@ let hash (s : key) =
 # 19
 module N = Bs_internalSetBuckets
 module C = Bs_internalBucketsType
+module A = Bs_Array
 type t = key N.t0 
 
 let rec insert_bucket  ~h_buckets ~ndata_tail h old_bucket = 
@@ -32,8 +33,8 @@ let resize  h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket  ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_HashSetString.ml

@@ -9,6 +9,7 @@ let hash (s : key) =
 # 19
 module N = Bs_internalSetBuckets
 module C = Bs_internalBucketsType
+module A = Bs_Array
 type t = key N.t0 
 
 let rec insert_bucket  ~h_buckets ~ndata_tail h old_bucket = 
@@ -32,8 +33,8 @@ let resize  h =
   let osize = Array.length odata in
   let nsize = osize * 2 in
   if nsize >= osize then begin (* no overflow *)
-    let h_buckets = C.makeSize nsize  in
-    let ndata_tail = C.makeSize nsize  in (* keep track of tail *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
     C.bucketsSet h  h_buckets;          (* so that indexfun sees the new bucket count *)
     for i = 0 to osize - 1 do
       insert_bucket  ~h_buckets ~ndata_tail h (Bs_Array.unsafe_get odata i)

jscomp/others/bs_Map.ml

@@ -14,7 +14,7 @@
 
 module N = Bs_internalAVLtree
 module B = Bs_Bag 
-type ('key, + 'a, 'id) t0 = ('key,'a) N.t0 
+type ('key,  'a, 'id) t0 = ('key,'a) N.t0 
 
 type ('k,'v,'id) t = 
   (('k,'id) Bs_Cmp.t,

jscomp/others/bs_Map.mli

@@ -12,7 +12,7 @@
 (***********************************************************************)
 (** Adapted by authors of BuckleScript without using functors          *)
 (** The type of the map keys. *)
-type ('k, + 'a, 'id) t0 
+type ('k,  'a, 'id) t0 
 (** [('k, 'a, id) t] 
     ['k] the key type 
     ['a] the value type

jscomp/others/bs_MapInt.ml

@@ -6,7 +6,7 @@ module N = Bs_internalAVLtree
 
 type ('key, 'a, 'id) t0 = ('key,'a) N.t0 
 
-type + 'a t = (key,'a) N.t0 
+type  'a t = (key,'a) N.t0 
 
 
 

jscomp/others/bs_MapInt.mli

@@ -1,7 +1,7 @@
 # 4 "map.cppo.mli"
 type key = int
 # 8
-type (+'a) t
+type 'a t
 (** The type of maps from type [key] to type ['a]. *)
 
 val empty: 'a t

jscomp/others/bs_MapString.ml

@@ -6,7 +6,7 @@ module N = Bs_internalAVLtree
 
 type ('key, 'a, 'id) t0 = ('key,'a) N.t0 
 
-type + 'a t = (key,'a) N.t0 
+type  'a t = (key,'a) N.t0 
 
 
 

jscomp/others/bs_MapString.mli

@@ -1,7 +1,7 @@
 # 2 "map.cppo.mli"
 type key = string
 # 8
-type (+'a) t
+type 'a t
 (** The type of maps from type [key] to type ['a]. *)
 
 val empty: 'a t

jscomp/others/bs_SetInt.ml

@@ -30,13 +30,107 @@ let checkInvariant = N.checkInvariant
 let add = I.add
 let ofArray = I.ofArray
 let cmp = I.cmp 
-let diff = I.diff
 let eq = I.eq 
 let findOpt = I.findOpt
-let split = I.split 
 let subset = I.subset 
-let inter = I.inter 
-let union = I.union
 let remove = I.remove 
 let mem = I.mem 
 
+let rec splitAuxNoPivot (n : _ N.node) (x : elt) : t * t =   
+  let l,v,r = N.(left n , key n, right n) in  
+  if x = v then l,  r
+  else if x < v then
+    match N.toOpt l with 
+    | None -> 
+      N.empty , N.return n
+    | Some l -> 
+      let ll,  rl = splitAuxNoPivot 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 r x in
+      N.joinShared l v lr,  rr
+
+
+let rec splitAuxPivot (n : _ N.node) (x : elt) pres : t  * t =   
+  let l,v,r = N.(left n , key n, right n) in  
+  if x = v then begin 
+    pres := true;  
+    (l, r)
+  end
+  else if x < v then
+    match N.toOpt l with 
+    | None -> 
+      N.empty, N.return n
+    | Some l -> 
+      let ll,  rl = splitAuxPivot 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 r x pres in
+      N.joinShared l v lr,  rr
+
+
+let split  (t : t) (x : elt) =
+  match N.toOpt t with 
+    None ->
+    (N.empty,  N.empty), false
+  | Some n  ->    
+    let pres = ref false in 
+    let v = splitAuxPivot n  x pres  in 
+    v, !pres
+
+let rec union (s1 : t) (s2 : t) =
+  match N.(toOpt s1, toOpt s2) with
+    (None, _) -> s2
+  | (_, None) -> s1
+  | Some n1, Some n2 (* (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) *) ->    
+    let h1, h2 = N.(h n1 , h n2) in             
+    if h1 >= h2 then
+      if h2 = 1 then I.add  s1 (N.key n2) else begin
+        let l1, v1, r1 = N.(left n1, key n1, right n1) in      
+        let (l2,  r2) = splitAuxNoPivot n2 v1 in
+        N.joinShared (union l1 l2) v1 (union r1 r2)
+      end
+    else
+    if h1 = 1 then add  s2 (N.key n1) else begin
+      let l2, v2, r2 = N.(left n2 , key n2, right n2) in 
+      let (l1, r1) = splitAuxNoPivot n1 v2 in
+      N.joinShared (union l1 l2) v2 (union r1 r2)
+    end
+
+let rec inter (s1 : t) (s2 : t) =
+  match N.(toOpt s1, toOpt s2) with
+    (None, _) 
+  | (_, None) -> N.empty
+  | Some n1, Some n2 (* (Node(l1, v1, r1, _), t2) *) ->
+    let l1,v1,r1 = N.(left n1, key n1, right n1) in  
+    let pres = ref false in 
+    let l2,r2 =  splitAuxPivot n2 v1 pres in 
+    let ll = inter l1 l2 in 
+    let rr = inter r1 r2 in 
+    if !pres then N.joinShared ll v1 rr 
+    else N.concatShared ll rr 
+
+let rec diff (s1 : t) (s2 : t) =
+  match N.(toOpt s1, toOpt s2) with
+  | (None, _) 
+  | (_, None) -> s1
+  | Some n1, Some n2 (* (Node(l1, v1, r1, _), t2) *) ->
+    let l1,v1,r1 = N.(left n1, key n1, right n1) in
+    let pres = ref false in 
+    let l2, r2 = splitAuxPivot  n2 v1 pres in 
+    let ll = diff  l1 l2 in 
+    let rr = diff  r1 r2 in 
+    if !pres then N.concatShared ll rr 
+    else N.joinShared ll v1 rr 
+
+
+
+