From e7d6847dde9d59d8d6c0ce74eced5c82a54f32f0 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Fri, 29 Dec 2017 12:26:59 +0800 Subject: [PATCH 1/3] assemble and share mutable methods --- jscomp/others/.depend | 12 +- jscomp/others/Makefile | 11 +- jscomp/others/bs.ml | 1 + jscomp/others/bs_Set.ml | 28 +- jscomp/others/bs_Set.mli | 8 +- jscomp/others/bs_SetInt.ml | 233 +---------- jscomp/others/bs_SetInt.mli | 5 +- jscomp/others/bs_SetIntM.ml | 39 ++ jscomp/others/bs_SetIntM.mli | 20 + jscomp/others/bs_SetString.ml | 233 +---------- jscomp/others/bs_SetString.mli | 5 +- jscomp/others/bs_internalAVLset.ml | 2 +- jscomp/others/bs_internalMutableAVLSet.ml | 102 ----- jscomp/others/bs_internalSetInt.ml | 301 +++++++++++++++ jscomp/others/bs_internalSetString.ml | 301 +++++++++++++++ jscomp/others/set.cppo.ml | 101 ++++- jscomp/others/set.cppo.mli | 5 +- jscomp/test/.depend | 4 +- jscomp/test/bs_map_test.js | 2 +- jscomp/test/bs_map_test.ml | 2 +- jscomp/test/bs_mutable_set_test.js | 42 +- jscomp/test/bs_mutable_set_test.ml | 26 +- jscomp/test/bs_set_bench.js | 2 +- jscomp/test/bs_set_bench.ml | 2 +- jscomp/test/class8_test.js | 20 +- jscomp/test/class8_test.ml | 6 +- lib/js/bs.js | 3 + lib/js/bs_Set.js | 26 +- lib/js/bs_SetInt.js | 340 +--------------- lib/js/bs_SetIntM.js | 27 ++ lib/js/bs_SetString.js | 340 +--------------- lib/js/bs_internalAVLset.js | 4 +- lib/js/bs_internalMutableAVLSet.js | 126 +++--- lib/js/bs_internalSetInt.js | 450 ++++++++++++++++++++++ lib/js/bs_internalSetString.js | 450 ++++++++++++++++++++++ 35 files changed, 1915 insertions(+), 1364 deletions(-) create mode 100644 jscomp/others/bs_SetIntM.ml create mode 100644 jscomp/others/bs_SetIntM.mli delete mode 100644 jscomp/others/bs_internalMutableAVLSet.ml create mode 100644 jscomp/others/bs_internalSetInt.ml create mode 100644 jscomp/others/bs_internalSetString.ml create mode 100644 lib/js/bs_SetIntM.js create mode 100644 lib/js/bs_internalSetInt.js create mode 100644 lib/js/bs_internalSetString.js diff --git a/jscomp/others/.depend b/jscomp/others/.depend index f886af0d379..69d8718629c 100644 --- a/jscomp/others/.depend +++ b/jscomp/others/.depend @@ -19,7 +19,7 @@ js_mapperRt.cmj : js_mapperRt.cmi bs_Array.cmj : js_math.cmj bs_Array.cmi bs_internalAVLset.cmj : bs_Array.cmj bs.cmj bs_internalAVLtree.cmj : -bs_internalMutableAVLSet.cmj : bs_internalAVLset.cmj +bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.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 @@ -42,12 +42,15 @@ bs_Bag.cmj : bs_Cmp.cmj : bs_Cmp.cmi bs_Map.cmj : bs_internalAVLtree.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \ bs_Map.cmi -bs_Set.cmj : bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \ +bs_Set.cmj : bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj bs.cmj \ bs_Set.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_SetInt.cmj : bs_internalAVLset.cmj bs_Array.cmj bs_SetInt.cmi -bs_SetString.cmj : bs_internalAVLset.cmj bs_Array.cmj bs_SetString.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_SetString.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \ + bs_SetString.cmi node_child_process.cmj : node.cmj js_boolean.cmj : js_boolean.cmi js_math.cmj : @@ -71,6 +74,7 @@ js_option.cmi : js_result.cmi : js_mapperRt.cmi : bs_Array.cmi : +bs_SetIntM.cmi : bs_Hash.cmi : bs_Queue.cmi : bs_List.cmi : js_json.cmi diff --git a/jscomp/others/Makefile b/jscomp/others/Makefile index da482992e41..7d7f3c1ae42 100644 --- a/jscomp/others/Makefile +++ b/jscomp/others/Makefile @@ -13,7 +13,7 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string bs_Array\ bs_internalAVLset\ bs_internalAVLtree\ - bs_internalMutableAVLSet\ + bs_SetIntM\ bs_internalMutableAVL\ bs_Hash\ bs_Queue\ @@ -33,7 +33,10 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string bs_Map\ bs_Set\ bs_MapString bs_MapInt\ - bs_SetInt bs_SetString\ + bs_internalSetInt\ + bs_internalSetString\ + bs_SetInt\ + bs_SetString\ node_child_process js_boolean js_math\ js_dict js_date js_global js_cast js_promise\ dom dom_storage\ @@ -93,11 +96,11 @@ bs_MapString.mli: map.cppo.mli cppo -D TYPE_STRING $^ > $@ bs_MapInt.mli: map.cppo.mli cppo -D TYPE_INT $^ > $@ -bs_SetInt.ml: set.cppo.ml +bs_internalSetInt.ml: set.cppo.ml cppo -D TYPE_INT $^ > $@ bs_SetInt.mli: set.cppo.mli cppo -D TYPE_INT $^ > $@ -bs_SetString.ml: set.cppo.ml +bs_internalSetString.ml: set.cppo.ml cppo -D TYPE_STRING $^ > $@ bs_SetString.mli: set.cppo.mli cppo -D TYPE_STRING $^ > $@ diff --git a/jscomp/others/bs.ml b/jscomp/others/bs.ml index 0ac2adb78a0..78db191a5c1 100644 --- a/jscomp/others/bs.ml +++ b/jscomp/others/bs.ml @@ -45,6 +45,7 @@ module Set = Bs_Set module MapInt = Bs_MapInt module MapString = Bs_MapString module SetInt = Bs_SetInt +module SetIntM = Bs_SetIntM module SetString = Bs_SetString module List = Bs_List diff --git a/jscomp/others/bs_Set.ml b/jscomp/others/bs_Set.ml index 1435fc4deb8..496e8e79e52 100644 --- a/jscomp/others/bs_Set.ml +++ b/jscomp/others/bs_Set.ml @@ -22,19 +22,19 @@ let forAll0 = N.forAll0 let exists0 = N.exists0 let filter0 = N.filter0 let partition0 = N.partition0 -let cardinal0 = N.cardinal0 +let length0 = N.length0 let elements0 = N.elements0 let toArray0 = N.toArray0 (* Insertion of one element *) -let rec add0 ~cmp x (t : _ t0) : _ t0 = +let rec add0 ~cmp (t : _ t0) x : _ t0 = match N.toOpt t with None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) | Some nt (* Node(l, v, r, _) as t *) -> let l,v,r = N.(left nt, key nt, right nt) in let c = (Bs_Cmp.getCmp cmp) x v [@bs] in if c = 0 then t else - if c < 0 then N.bal (add0 ~cmp x l) v r else N.bal l v (add0 ~cmp x r) + if c < 0 then N.bal (add0 ~cmp l x ) v r else N.bal l v (add0 ~cmp r x ) (* Splitting. split x s returns a triple (l, present, r) where @@ -90,13 +90,13 @@ let rec union0 ~cmp (s1 : _ t0) (s2 : _ t0) : _ t0= | 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 add0 ~cmp (N.key n2) s1 else begin + 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) = split0 ~cmp v1 s2 in N.join (union0 ~cmp l1 l2) v1 (union0 ~cmp r1 r2) end else - if h1 = 1 then add0 ~cmp (N.key n1) s2 else begin + 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) = split0 ~cmp v2 s1 in N.join (union0 ~cmp l1 l2) v2 (union0 ~cmp r1 r2) @@ -184,10 +184,20 @@ let rec findAssert0 ~cmp x (n : _ t0) = let ofArray0 ~cmp (xs : _ array) : _ t0 = let result = ref N.empty in for i = 0 to Array.length xs - 1 do - result := add0 ~cmp (Bs_Array.unsafe_get xs i) !result + result := add0 ~cmp !result (Bs_Array.unsafe_get xs i) done ; !result +(* TOOD: optimize heuristics for resizing *) +let addArray0 ~cmp h arr = + let len = Bs.Array.length arr in + let v = ref empty0 in + for i = 0 to len - 1 do + let key = (Bs_Array.unsafe_get arr i) in + v := add0 !v ~cmp key + done ; + !v + let empty dict = B.bag ~dict @@ -207,11 +217,11 @@ let mem (type elt) (type id) e (m : (elt,id) t) = let module M = (val dict) in mem0 ~cmp:(M.cmp) e data -let add (type elt) (type id) e (m : (elt,id) t) = +let add (type elt) (type id) (m : (elt,id) t) e = let dict, data = B.(dict m, data m) in let module M = (val dict) in B.bag ~dict - ~data:(add0 ~cmp:(M.cmp) e data) + ~data:(add0 ~cmp:(M.cmp) data e) let singleton dict e = B.bag ~dict @@ -275,7 +285,7 @@ let partition f m = let l,r = partition0 f mdata in B.bag ~data:l ~dict, B.bag ~data:r ~dict -let cardinal m = cardinal0 (B.data m) +let length m = length0 (B.data m) let elements m = elements0 (B.data m) let toArray m = toArray0 (B.data m) diff --git a/jscomp/others/bs_Set.mli b/jscomp/others/bs_Set.mli index 0f9b531da5c..3665c0544fa 100644 --- a/jscomp/others/bs_Set.mli +++ b/jscomp/others/bs_Set.mli @@ -32,9 +32,9 @@ val mem: val add0: cmp: ('elt,'id) Bs_Cmp.cmp -> - 'elt -> ('elt, 'id) t0 -> ('elt, 'id) t0 + ('elt, 'id) t0 -> 'elt -> ('elt, 'id) t0 val add: - 'elt -> ('elt, 'id) t -> ('elt, 'id) t + ('elt, 'id) t -> 'elt -> ('elt, 'id) t (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) @@ -130,8 +130,8 @@ val partition: ('elt -> bool [@bs]) -> ('elt, 'id) t -> ('elt, 'id) t * ('elt, ' predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) -val cardinal0: ('elt, 'id) t0 -> int -val cardinal:('elt, 'id) t -> int +val length0: ('elt, 'id) t0 -> int +val length: ('elt, 'id) t -> int (** Return the number of elements of a set. *) val elements0: ('elt, 'id) t0 -> 'elt list diff --git a/jscomp/others/bs_SetInt.ml b/jscomp/others/bs_SetInt.ml index 61dd220cf34..45ce63553cb 100644 --- a/jscomp/others/bs_SetInt.ml +++ b/jscomp/others/bs_SetInt.ml @@ -1,20 +1,9 @@ -# 4 "set.cppo.ml" -type elt = int - - -# 10 module N = Bs_internalAVLset +module I = Bs_internalSetInt -type ('elt, 'id) t0 = ('elt, 'id) N.t0 +type elt = I.elt +type t = I.t -type ('elt, 'id) enumeration0 = - ('elt, 'id) N.enumeration0 -= - End - | More of 'elt * ('elt, 'id) t0 * ('elt, 'id) enumeration0 - -type t = (elt, unit) t0 -type enumeration = (elt,unit) enumeration0 let empty = N.empty0 let isEmpty = N.isEmpty0 @@ -27,210 +16,20 @@ let forAll = N.forAll0 let exists = N.exists0 let filter = N.filter0 let partition = N.partition0 -let cardinal = N.cardinal0 +let length = N.length0 let elements = N.elements0 let toArray = N.toArray0 let checkInvariant = N.checkInvariant -(* Insertion of one element *) - -let rec add (x : elt) (t : t) : t = - match N.toOpt t with - None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) - | Some nt (* Node(l, v, r, _) as t *) -> - let v = N.key nt in - if x = v then t else - if x < v then N.(bal (add x (left nt)) v (right nt)) - else N.(bal (left nt) v (add x (right nt))) - - - -(* Splitting. split x s returns a triple (l, present, r) where - - l is the set of elements of s that are < x - - r is the set of elements of s that are > x - - present is false if s contains no element equal to x, - or true if s contains an element equal to x. *) - -let rec splitAux (x : elt) (n : _ N.node) : t * bool * t = - let l,v,r = N.(left n , key n, right n) in - if x = v then (l, true, r) - else if x < v then - match N.toOpt l with - | None -> - N.(empty , false, return n) - | Some l -> - let (ll, pres, rl) = splitAux x l in (ll, pres, N.join rl v r) - else - match N.toOpt r with - | None -> - N.(return n, false, empty) - | Some r -> - let (lr, pres, rr) = splitAux x r in (N.join l v lr, pres, rr) - - -let rec split (x : elt) (t : t) : t * bool * t = - match N.toOpt t with - None -> - N.(empty, false, empty) - | Some n (* Node(l, v, r, _)*) -> - splitAux x n - - -let rec mem (x : elt) (t : t) = - match N.toOpt t with - | None -> false - | Some n (* Node(l, v, r, _) *) -> - let v = N.key n in - x = v || mem x N.(if x < v then (left n) else (right n)) - -let rec remove (x : elt) (t : t) : t = - match N.toOpt t with - | None -> t - | Some n (* Node(l, v, r, _) *) -> - let l,v,r = N.(left n, key n, right n) in - if x = v then N.merge l r else - if x < v then N.bal (remove x l) v r - else N.bal l v (remove x r) - -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 add (N.key n2) s1 else begin - let l1, v1, r1 = N.(left n1, key n1, right n1) in - let (l2, _, r2) = splitAux v1 n2 in - N.join (union l1 l2) v1 (union r1 r2) - end - else - if h1 = 1 then add (N.key n1) s2 else begin - let l2, v2, r2 = N.(left n2 , key n2, right n2) in - let (l1, _, r1) = splitAux v2 n1 in - N.join (union l1 l2) v2 (union r1 r2) - end - -let rec inter (s1 : t) (s2 : t) = - match N.(toOpt s1, toOpt s2) with - (None, _) -> s1 - | (_, None) -> s2 - | Some n1, Some n2 (* (Node(l1, v1, r1, _), t2) *) -> - let l1,v1,r1 = N.(left n1, key n1, right n1) in - match splitAux v1 n2 with - (l2, false, r2) -> - N.concat (inter l1 l2) (inter r1 r2) - | (l2, true, r2) -> - N.join (inter l1 l2) v1 (inter r1 r2) - -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 - match splitAux v1 n2 with - (l2, false, r2) -> - N.join (diff l1 l2) v1 (diff r1 r2) - | (l2, true, r2) -> - N.concat (diff l1 l2) (diff r1 r2) - - -let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, r1, e1), More(v2, r2, e2)) -> - if (v1 : elt) <> v2 - then if v1 < v2 then -1 else 1 - else compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - -let cmp s1 s2 = - compare_aux (N.cons_enum s1 End) (N.cons_enum s2 End) - -let rec eq_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, More _) -> false - | (More _, End) -> false - | (More(v1, r1, e1), More(v2, r2, e2)) -> - (v1 : elt) = v2 && - eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - -let eq s1 s2 = - eq_aux (N.cons_enum s1 End) (N.cons_enum s2 End) - -let rec subset (s1 : t) (s2 : t) = - match N.(toOpt s1, toOpt s2) with - None, _ -> - true - | _, None -> - false - | Some t1, Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) -> - let l1,v1,r1 = N.(left t1, key t1, right t1) in - let l2,v2,r2 = N.(left t2, key t2, right t2) in - if (v1 : elt) = v2 then - subset l1 l2 && subset r1 r2 - else if v1 < v2 then - subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2 - else - subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2 - - -let rec findOpt (x : elt) (n :t) = - match N.toOpt n with - | None -> None - | Some t (* Node(l, v, r, _) *) -> - let v = N.key t in - if x = v then Some v - else findOpt x N.(if x < v then (left t) else (right t)) - -let rec findAssert (x : elt) (n :t) = - match N.toOpt n with - | None -> [%assert "Not_found"] - | Some t (* Node(l, v, r, _) *) -> - let v = N.key t in - if x = v then Some v - else findAssert x N.(if x < v then (left t) else (right t)) - - -(* FIXME: use [sorted] attribute *) -let ofArray (xs : elt array) : t = - let result = ref N.empty in - for i = 0 to Array.length xs - 1 do - result := add (Bs_Array.unsafe_get xs i) !result - done ; - !result - -(* -let of_sorted_list l = - let rec sub n l = - match n, l with - | 0, l -> Empty, l - | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l - | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l - | 3, x0 :: x1 :: x2 :: l -> - Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l - | n, l -> - let nl = n / 2 in - let left, l = sub nl l in - match l with - | [] -> assert false - | mid :: l -> - let right, l = sub (n - nl - 1) l in - create left mid right, l - in - fst (sub (List.length l) l) -*) -(* -let of_list l = - match l with - | [] -> empty - | [x0] -> singleton x0 - | [x0; x1] -> add x1 (singleton x0) - | [x0; x1; x2] -> add x2 (add x1 (singleton x0)) - | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0))) - | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) - | _ -> of_sorted_list (List.sort_uniq Pervasives.compare l) -*) +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 diff --git a/jscomp/others/bs_SetInt.mli b/jscomp/others/bs_SetInt.mli index b2066064bb5..2cdd9d421f0 100644 --- a/jscomp/others/bs_SetInt.mli +++ b/jscomp/others/bs_SetInt.mli @@ -13,7 +13,7 @@ val empty: t val isEmpty: t -> bool (** Test whether a set is empty or not. *) -val mem: elt -> t -> bool +val mem: t -> elt -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) val add: elt -> t -> t @@ -75,8 +75,7 @@ val partition: (elt -> bool [@bs]) -> t -> t * t predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) -val cardinal: t -> int -(** Return the number of elements of a set. *) +val length: t -> int val elements: t -> elt list (** Return the list of all elements of the given set. diff --git a/jscomp/others/bs_SetIntM.ml b/jscomp/others/bs_SetIntM.ml new file mode 100644 index 00000000000..49e8d2f0b2b --- /dev/null +++ b/jscomp/others/bs_SetIntM.ml @@ -0,0 +1,39 @@ + + +module N = Bs_internalAVLset + + +module I = Bs_internalSetInt + +type elt = I.elt +type t = I.t + + +let empty = N.empty0 +let isEmpty = N.isEmpty0 +let singleton = N.singleton0 +let min = N.min0 +let max = N.max0 +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 length = N.length0 +let elements = N.elements0 +let toArray = N.toArray0 +let checkInvariant = N.checkInvariant + +let add = I.addMutate +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 diff --git a/jscomp/others/bs_SetIntM.mli b/jscomp/others/bs_SetIntM.mli new file mode 100644 index 00000000000..8c6ac46b485 --- /dev/null +++ b/jscomp/others/bs_SetIntM.mli @@ -0,0 +1,20 @@ +type t +type elt = int + +val empty: t + + +val isEmpty: t -> bool +(** Test whether a set is empty or not. *) + +val mem: t -> elt -> bool + + +val add: t -> elt -> t + +val singleton: elt -> t +(** [singleton x] returns the one-element set containing only [x]. *) + +val checkInvariant: t -> bool + +val length : t -> int \ No newline at end of file diff --git a/jscomp/others/bs_SetString.ml b/jscomp/others/bs_SetString.ml index d9d2894c55e..074e3c0c633 100644 --- a/jscomp/others/bs_SetString.ml +++ b/jscomp/others/bs_SetString.ml @@ -1,20 +1,9 @@ -# 2 "set.cppo.ml" -type elt = string - - -# 10 module N = Bs_internalAVLset +module I = Bs_internalSetString -type ('elt, 'id) t0 = ('elt, 'id) N.t0 +type elt = I.elt +type t = I.t -type ('elt, 'id) enumeration0 = - ('elt, 'id) N.enumeration0 -= - End - | More of 'elt * ('elt, 'id) t0 * ('elt, 'id) enumeration0 - -type t = (elt, unit) t0 -type enumeration = (elt,unit) enumeration0 let empty = N.empty0 let isEmpty = N.isEmpty0 @@ -27,210 +16,20 @@ let forAll = N.forAll0 let exists = N.exists0 let filter = N.filter0 let partition = N.partition0 -let cardinal = N.cardinal0 +let length = N.length0 let elements = N.elements0 let toArray = N.toArray0 let checkInvariant = N.checkInvariant -(* Insertion of one element *) - -let rec add (x : elt) (t : t) : t = - match N.toOpt t with - None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) - | Some nt (* Node(l, v, r, _) as t *) -> - let v = N.key nt in - if x = v then t else - if x < v then N.(bal (add x (left nt)) v (right nt)) - else N.(bal (left nt) v (add x (right nt))) - - - -(* Splitting. split x s returns a triple (l, present, r) where - - l is the set of elements of s that are < x - - r is the set of elements of s that are > x - - present is false if s contains no element equal to x, - or true if s contains an element equal to x. *) - -let rec splitAux (x : elt) (n : _ N.node) : t * bool * t = - let l,v,r = N.(left n , key n, right n) in - if x = v then (l, true, r) - else if x < v then - match N.toOpt l with - | None -> - N.(empty , false, return n) - | Some l -> - let (ll, pres, rl) = splitAux x l in (ll, pres, N.join rl v r) - else - match N.toOpt r with - | None -> - N.(return n, false, empty) - | Some r -> - let (lr, pres, rr) = splitAux x r in (N.join l v lr, pres, rr) - - -let rec split (x : elt) (t : t) : t * bool * t = - match N.toOpt t with - None -> - N.(empty, false, empty) - | Some n (* Node(l, v, r, _)*) -> - splitAux x n - - -let rec mem (x : elt) (t : t) = - match N.toOpt t with - | None -> false - | Some n (* Node(l, v, r, _) *) -> - let v = N.key n in - x = v || mem x N.(if x < v then (left n) else (right n)) - -let rec remove (x : elt) (t : t) : t = - match N.toOpt t with - | None -> t - | Some n (* Node(l, v, r, _) *) -> - let l,v,r = N.(left n, key n, right n) in - if x = v then N.merge l r else - if x < v then N.bal (remove x l) v r - else N.bal l v (remove x r) - -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 add (N.key n2) s1 else begin - let l1, v1, r1 = N.(left n1, key n1, right n1) in - let (l2, _, r2) = splitAux v1 n2 in - N.join (union l1 l2) v1 (union r1 r2) - end - else - if h1 = 1 then add (N.key n1) s2 else begin - let l2, v2, r2 = N.(left n2 , key n2, right n2) in - let (l1, _, r1) = splitAux v2 n1 in - N.join (union l1 l2) v2 (union r1 r2) - end - -let rec inter (s1 : t) (s2 : t) = - match N.(toOpt s1, toOpt s2) with - (None, _) -> s1 - | (_, None) -> s2 - | Some n1, Some n2 (* (Node(l1, v1, r1, _), t2) *) -> - let l1,v1,r1 = N.(left n1, key n1, right n1) in - match splitAux v1 n2 with - (l2, false, r2) -> - N.concat (inter l1 l2) (inter r1 r2) - | (l2, true, r2) -> - N.join (inter l1 l2) v1 (inter r1 r2) - -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 - match splitAux v1 n2 with - (l2, false, r2) -> - N.join (diff l1 l2) v1 (diff r1 r2) - | (l2, true, r2) -> - N.concat (diff l1 l2) (diff r1 r2) - - -let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, r1, e1), More(v2, r2, e2)) -> - if (v1 : elt) <> v2 - then if v1 < v2 then -1 else 1 - else compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - -let cmp s1 s2 = - compare_aux (N.cons_enum s1 End) (N.cons_enum s2 End) - -let rec eq_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, More _) -> false - | (More _, End) -> false - | (More(v1, r1, e1), More(v2, r2, e2)) -> - (v1 : elt) = v2 && - eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - -let eq s1 s2 = - eq_aux (N.cons_enum s1 End) (N.cons_enum s2 End) - -let rec subset (s1 : t) (s2 : t) = - match N.(toOpt s1, toOpt s2) with - None, _ -> - true - | _, None -> - false - | Some t1, Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) -> - let l1,v1,r1 = N.(left t1, key t1, right t1) in - let l2,v2,r2 = N.(left t2, key t2, right t2) in - if (v1 : elt) = v2 then - subset l1 l2 && subset r1 r2 - else if v1 < v2 then - subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2 - else - subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2 - - -let rec findOpt (x : elt) (n :t) = - match N.toOpt n with - | None -> None - | Some t (* Node(l, v, r, _) *) -> - let v = N.key t in - if x = v then Some v - else findOpt x N.(if x < v then (left t) else (right t)) - -let rec findAssert (x : elt) (n :t) = - match N.toOpt n with - | None -> [%assert "Not_found"] - | Some t (* Node(l, v, r, _) *) -> - let v = N.key t in - if x = v then Some v - else findAssert x N.(if x < v then (left t) else (right t)) - - -(* FIXME: use [sorted] attribute *) -let ofArray (xs : elt array) : t = - let result = ref N.empty in - for i = 0 to Array.length xs - 1 do - result := add (Bs_Array.unsafe_get xs i) !result - done ; - !result - -(* -let of_sorted_list l = - let rec sub n l = - match n, l with - | 0, l -> Empty, l - | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l - | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l - | 3, x0 :: x1 :: x2 :: l -> - Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l - | n, l -> - let nl = n / 2 in - let left, l = sub nl l in - match l with - | [] -> assert false - | mid :: l -> - let right, l = sub (n - nl - 1) l in - create left mid right, l - in - fst (sub (List.length l) l) -*) -(* -let of_list l = - match l with - | [] -> empty - | [x0] -> singleton x0 - | [x0; x1] -> add x1 (singleton x0) - | [x0; x1; x2] -> add x2 (add x1 (singleton x0)) - | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0))) - | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) - | _ -> of_sorted_list (List.sort_uniq Pervasives.compare l) -*) +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 diff --git a/jscomp/others/bs_SetString.mli b/jscomp/others/bs_SetString.mli index eeaf7b010ae..58b44707a3c 100644 --- a/jscomp/others/bs_SetString.mli +++ b/jscomp/others/bs_SetString.mli @@ -13,7 +13,7 @@ val empty: t val isEmpty: t -> bool (** Test whether a set is empty or not. *) -val mem: elt -> t -> bool +val mem: t -> elt -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) val add: elt -> t -> t @@ -75,8 +75,7 @@ val partition: (elt -> bool [@bs]) -> t -> t * t predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) -val cardinal: t -> int -(** Return the number of elements of a set. *) +val length: t -> int val elements: t -> elt list (** Return the list of all elements of the given set. diff --git a/jscomp/others/bs_internalAVLset.ml b/jscomp/others/bs_internalAVLset.ml index 71206bb7cff..03117ba9b97 100644 --- a/jscomp/others/bs_internalAVLset.ml +++ b/jscomp/others/bs_internalAVLset.ml @@ -229,7 +229,7 @@ let rec cardinalAux n = | Some r -> cardinalAux r in 1 + sizeL + sizeR -let rec cardinal0 n = +let rec length0 n = match toOpt n with | None -> 0 | Some n -> diff --git a/jscomp/others/bs_internalMutableAVLSet.ml b/jscomp/others/bs_internalMutableAVLSet.ml deleted file mode 100644 index f2621e67252..00000000000 --- a/jscomp/others/bs_internalMutableAVLSet.ml +++ /dev/null @@ -1,102 +0,0 @@ - - -module N = Bs_internalAVLset - -type 'elt node = 'elt N.node - -type ('elt,'id) t0 = 'elt node Js.null - -external unsafeCoerce : 'a Js.null -> 'a = "%identity" - - - -let empty = N.empty0 -let isEmpty = N.isEmpty0 -let singleton = N.singleton0 -let min = N.min0 -let max = N.max0 -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 cardinal = N.cardinal0 -let elements = N.elements0 -let checkInvariant = N.checkInvariant -(* - L rotation, return root node -*) -let rotateWithLeftChild k2 = - let k1 = unsafeCoerce (N.left k2) in - N.(leftSet k2 (right k1)); - N.(rightSet k1 (return k2 )); - let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in - N.(hSet k2 - (Pervasives.max hlk2 hrk2 + 1)); - let hlk1, hk2 = N.(height (left k1), (h k2)) in - N.(hSet k1 (Pervasives.max hlk1 hk2 + 1)); - k1 -(* right rotation *) -let rotateWithRightChild k1 = - let k2 = unsafeCoerce (N.right k1) in - N.(rightSet k1 (left k2)); - N.(leftSet k2 (return k1)); - let hlk1, hrk1 = N.((height (left k1)), (height (right k1))) in - N.(hSet k1 (Pervasives.max hlk1 hrk1 + 1)); - let hrk2, hk1 = N.(height (right k2), (h k1)) in - N.(hSet k2 (Pervasives.max hrk2 hk1 + 1)); - k2 - -(* - double l rotation -*) -let doubleWithLeftChild k3 = - let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in - N.(leftSet k3 (return v )); - rotateWithLeftChild k3 - -let doubleWithRightChild k2 = - let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in - N.(rightSet k2 (return v)); - rotateWithRightChild k2 -type key = int - -let rec add (x : key) (t : _ t0) = - match N.toOpt t with - | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) - | Some nt -> - let k = N.key nt in - if x = k then t - else - begin - let l, r = N.(left nt, right nt) in - let t = - (if x < k then - begin - N.leftSet nt (add x l); - (if N.height l > 2 + N.height r then - (if x < N.key (unsafeCoerce l) then - rotateWithLeftChild nt - else - doubleWithLeftChild nt ) - else nt ) - end - else - begin - N.rightSet nt (add x r); - (if N.height r > 2 + N.height l then - (if N.key (unsafeCoerce r) < x then - rotateWithRightChild nt - else - doubleWithRightChild nt - ) else - nt - ) - end - ) in - let hlt, hrt = N.(height (left t),(height (right t))) in - N.hSet t - N.(Pervasives.max hlt hrt + 1); - N.return t - end \ No newline at end of file diff --git a/jscomp/others/bs_internalSetInt.ml b/jscomp/others/bs_internalSetInt.ml new file mode 100644 index 00000000000..6f83490245d --- /dev/null +++ b/jscomp/others/bs_internalSetInt.ml @@ -0,0 +1,301 @@ +# 4 "set.cppo.ml" +type elt = int + + +# 10 +module N = Bs_internalAVLset + +type ('elt, 'id) t0 = ('elt, 'id) N.t0 + +type ('elt, 'id) enumeration0 = + ('elt, 'id) N.enumeration0 += + End + | More of 'elt * ('elt, 'id) t0 * ('elt, 'id) enumeration0 + +type t = (elt, unit) t0 +type enumeration = (elt,unit) enumeration0 + + +let rec add (x : elt) (t : t) : t = + match N.toOpt t with + None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) + | Some nt (* Node(l, v, r, _) as t *) -> + let v = N.key nt in + if x = v then t else + if x < v then N.(bal (add x (left nt)) v (right nt)) + else N.(bal (left nt) v (add x (right nt))) + + + +(* Splitting. split x s returns a triple (l, present, r) where + - l is the set of elements of s that are < x + - r is the set of elements of s that are > x + - present is false if s contains no element equal to x, + or true if s contains an element equal to x. *) + +let rec splitAux (x : elt) (n : _ N.node) : t * bool * t = + let l,v,r = N.(left n , key n, right n) in + if x = v then (l, true, r) + else if x < v then + match N.toOpt l with + | None -> + N.(empty , false, return n) + | Some l -> + let (ll, pres, rl) = splitAux x l in (ll, pres, N.join rl v r) + else + match N.toOpt r with + | None -> + N.(return n, false, empty) + | Some r -> + let (lr, pres, rr) = splitAux x r in (N.join l v lr, pres, rr) + + +let rec split (x : elt) (t : t) : t * bool * t = + match N.toOpt t with + None -> + N.(empty, false, empty) + | Some n (* Node(l, v, r, _)*) -> + splitAux x n + + +let rec mem (t : t) (x : elt) = + match N.toOpt t with + | None -> false + | Some n (* Node(l, v, r, _) *) -> + let v = N.key n in + x = v || mem N.(if x < v then (left n) else (right n)) x + +let rec remove (x : elt) (t : t) : t = + match N.toOpt t with + | None -> t + | Some n (* Node(l, v, r, _) *) -> + let l,v,r = N.(left n, key n, right n) in + if x = v then N.merge l r else + if x < v then N.bal (remove x l) v r + else N.bal l v (remove x r) + +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 add (N.key n2) s1 else begin + let l1, v1, r1 = N.(left n1, key n1, right n1) in + let (l2, _, r2) = splitAux v1 n2 in + N.join (union l1 l2) v1 (union r1 r2) + end + else + if h1 = 1 then add (N.key n1) s2 else begin + let l2, v2, r2 = N.(left n2 , key n2, right n2) in + let (l1, _, r1) = splitAux v2 n1 in + N.join (union l1 l2) v2 (union r1 r2) + end + +let rec inter (s1 : t) (s2 : t) = + match N.(toOpt s1, toOpt s2) with + (None, _) -> s1 + | (_, None) -> s2 + | Some n1, Some n2 (* (Node(l1, v1, r1, _), t2) *) -> + let l1,v1,r1 = N.(left n1, key n1, right n1) in + match splitAux v1 n2 with + (l2, false, r2) -> + N.concat (inter l1 l2) (inter r1 r2) + | (l2, true, r2) -> + N.join (inter l1 l2) v1 (inter r1 r2) + +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 + match splitAux v1 n2 with + (l2, false, r2) -> + N.join (diff l1 l2) v1 (diff r1 r2) + | (l2, true, r2) -> + N.concat (diff l1 l2) (diff r1 r2) + + +let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, r1, e1), More(v2, r2, e2)) -> + if (v1 : elt) <> v2 + then if v1 < v2 then -1 else 1 + else compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) + +let cmp s1 s2 = + compare_aux (N.cons_enum s1 End) (N.cons_enum s2 End) + +let rec eq_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, More _) -> false + | (More _, End) -> false + | (More(v1, r1, e1), More(v2, r2, e2)) -> + (v1 : elt) = v2 && + eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) + +let eq s1 s2 = + eq_aux (N.cons_enum s1 End) (N.cons_enum s2 End) + +let rec subset (s1 : t) (s2 : t) = + match N.(toOpt s1, toOpt s2) with + None, _ -> + true + | _, None -> + false + | Some t1, Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) -> + let l1,v1,r1 = N.(left t1, key t1, right t1) in + let l2,v2,r2 = N.(left t2, key t2, right t2) in + if (v1 : elt) = v2 then + subset l1 l2 && subset r1 r2 + else if v1 < v2 then + subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2 + else + subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2 + + +let rec findOpt (x : elt) (n :t) = + match N.toOpt n with + | None -> None + | Some t (* Node(l, v, r, _) *) -> + let v = N.key t in + if x = v then Some v + else findOpt x N.(if x < v then (left t) else (right t)) + +let rec findAssert (x : elt) (n :t) = + match N.toOpt n with + | None -> [%assert "Not_found"] + | Some t (* Node(l, v, r, _) *) -> + let v = N.key t in + if x = v then Some v + else findAssert x N.(if x < v then (left t) else (right t)) + + +(* FIXME: use [sorted] attribute *) +let ofArray (xs : elt array) : t = + let result = ref N.empty in + for i = 0 to Array.length xs - 1 do + result := add (Bs_Array.unsafe_get xs i) !result + done ; + !result + + +(* +let of_sorted_list l = + let rec sub n l = + match n, l with + | 0, l -> Empty, l + | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l + | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l + | 3, x0 :: x1 :: x2 :: l -> + Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l + | n, l -> + let nl = n / 2 in + let left, l = sub nl l in + match l with + | [] -> assert false + | mid :: l -> + let right, l = sub (n - nl - 1) l in + create left mid right, l + in + fst (sub (List.length l) l) +*) +(* +let of_list l = + match l with + | [] -> empty + | [x0] -> singleton x0 + | [x0; x1] -> add x1 (singleton x0) + | [x0; x1; x2] -> add x2 (add x1 (singleton x0)) + | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0))) + | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) + | _ -> of_sorted_list (List.sort_uniq Pervasives.compare l) +*) + + + +external unsafeCoerce : 'a Js.null -> 'a = "%identity" + +(* + L rotation, return root node +*) +let rotateWithLeftChild k2 = + let k1 = unsafeCoerce (N.left k2) in + N.(leftSet k2 (right k1)); + N.(rightSet k1 (return k2 )); + let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in + N.(hSet k2 + (Pervasives.max hlk2 hrk2 + 1)); + let hlk1, hk2 = N.(height (left k1), (h k2)) in + N.(hSet k1 (Pervasives.max hlk1 hk2 + 1)); + k1 +(* right rotation *) +let rotateWithRightChild k1 = + let k2 = unsafeCoerce (N.right k1) in + N.(rightSet k1 (left k2)); + N.(leftSet k2 (return k1)); + let hlk1, hrk1 = N.((height (left k1)), (height (right k1))) in + N.(hSet k1 (Pervasives.max hlk1 hrk1 + 1)); + let hrk2, hk1 = N.(height (right k2), (h k1)) in + N.(hSet k2 (Pervasives.max hrk2 hk1 + 1)); + k2 + +(* + double l rotation +*) +let doubleWithLeftChild k3 = + let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in + N.(leftSet k3 (return v )); + rotateWithLeftChild k3 + +let doubleWithRightChild k2 = + let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in + N.(rightSet k2 (return v)); + rotateWithRightChild k2 +type key = int + +let rec addMutate (t : _ t0) (x : key)= + match N.toOpt t with + | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) + | Some nt -> + let k = N.key nt in + if x = k then t + else + begin + let l, r = N.(left nt, right nt) in + let t = + (if x < k then + begin + N.leftSet nt (addMutate l x); + (if N.height l > 2 + N.height r then + (if x < N.key (unsafeCoerce l) then + rotateWithLeftChild nt + else + doubleWithLeftChild nt ) + else nt ) + end + else + begin + N.rightSet nt (addMutate r x); + (if N.height r > 2 + N.height l then + (if N.key (unsafeCoerce r) < x then + rotateWithRightChild nt + else + doubleWithRightChild nt + ) else + nt + ) + end + ) in + let hlt, hrt = N.(height (left t),(height (right t))) in + N.hSet t + N.(Pervasives.max hlt hrt + 1); + N.return t + end \ No newline at end of file diff --git a/jscomp/others/bs_internalSetString.ml b/jscomp/others/bs_internalSetString.ml new file mode 100644 index 00000000000..a574a82988e --- /dev/null +++ b/jscomp/others/bs_internalSetString.ml @@ -0,0 +1,301 @@ +# 2 "set.cppo.ml" +type elt = string + + +# 10 +module N = Bs_internalAVLset + +type ('elt, 'id) t0 = ('elt, 'id) N.t0 + +type ('elt, 'id) enumeration0 = + ('elt, 'id) N.enumeration0 += + End + | More of 'elt * ('elt, 'id) t0 * ('elt, 'id) enumeration0 + +type t = (elt, unit) t0 +type enumeration = (elt,unit) enumeration0 + + +let rec add (x : elt) (t : t) : t = + match N.toOpt t with + None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) + | Some nt (* Node(l, v, r, _) as t *) -> + let v = N.key nt in + if x = v then t else + if x < v then N.(bal (add x (left nt)) v (right nt)) + else N.(bal (left nt) v (add x (right nt))) + + + +(* Splitting. split x s returns a triple (l, present, r) where + - l is the set of elements of s that are < x + - r is the set of elements of s that are > x + - present is false if s contains no element equal to x, + or true if s contains an element equal to x. *) + +let rec splitAux (x : elt) (n : _ N.node) : t * bool * t = + let l,v,r = N.(left n , key n, right n) in + if x = v then (l, true, r) + else if x < v then + match N.toOpt l with + | None -> + N.(empty , false, return n) + | Some l -> + let (ll, pres, rl) = splitAux x l in (ll, pres, N.join rl v r) + else + match N.toOpt r with + | None -> + N.(return n, false, empty) + | Some r -> + let (lr, pres, rr) = splitAux x r in (N.join l v lr, pres, rr) + + +let rec split (x : elt) (t : t) : t * bool * t = + match N.toOpt t with + None -> + N.(empty, false, empty) + | Some n (* Node(l, v, r, _)*) -> + splitAux x n + + +let rec mem (t : t) (x : elt) = + match N.toOpt t with + | None -> false + | Some n (* Node(l, v, r, _) *) -> + let v = N.key n in + x = v || mem N.(if x < v then (left n) else (right n)) x + +let rec remove (x : elt) (t : t) : t = + match N.toOpt t with + | None -> t + | Some n (* Node(l, v, r, _) *) -> + let l,v,r = N.(left n, key n, right n) in + if x = v then N.merge l r else + if x < v then N.bal (remove x l) v r + else N.bal l v (remove x r) + +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 add (N.key n2) s1 else begin + let l1, v1, r1 = N.(left n1, key n1, right n1) in + let (l2, _, r2) = splitAux v1 n2 in + N.join (union l1 l2) v1 (union r1 r2) + end + else + if h1 = 1 then add (N.key n1) s2 else begin + let l2, v2, r2 = N.(left n2 , key n2, right n2) in + let (l1, _, r1) = splitAux v2 n1 in + N.join (union l1 l2) v2 (union r1 r2) + end + +let rec inter (s1 : t) (s2 : t) = + match N.(toOpt s1, toOpt s2) with + (None, _) -> s1 + | (_, None) -> s2 + | Some n1, Some n2 (* (Node(l1, v1, r1, _), t2) *) -> + let l1,v1,r1 = N.(left n1, key n1, right n1) in + match splitAux v1 n2 with + (l2, false, r2) -> + N.concat (inter l1 l2) (inter r1 r2) + | (l2, true, r2) -> + N.join (inter l1 l2) v1 (inter r1 r2) + +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 + match splitAux v1 n2 with + (l2, false, r2) -> + N.join (diff l1 l2) v1 (diff r1 r2) + | (l2, true, r2) -> + N.concat (diff l1 l2) (diff r1 r2) + + +let rec compare_aux e1 e2 = + match (e1, e2) with + (End, End) -> 0 + | (End, _) -> -1 + | (_, End) -> 1 + | (More(v1, r1, e1), More(v2, r2, e2)) -> + if (v1 : elt) <> v2 + then if v1 < v2 then -1 else 1 + else compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) + +let cmp s1 s2 = + compare_aux (N.cons_enum s1 End) (N.cons_enum s2 End) + +let rec eq_aux e1 e2 = + match (e1, e2) with + (End, End) -> true + | (End, More _) -> false + | (More _, End) -> false + | (More(v1, r1, e1), More(v2, r2, e2)) -> + (v1 : elt) = v2 && + eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) + +let eq s1 s2 = + eq_aux (N.cons_enum s1 End) (N.cons_enum s2 End) + +let rec subset (s1 : t) (s2 : t) = + match N.(toOpt s1, toOpt s2) with + None, _ -> + true + | _, None -> + false + | Some t1, Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) -> + let l1,v1,r1 = N.(left t1, key t1, right t1) in + let l2,v2,r2 = N.(left t2, key t2, right t2) in + if (v1 : elt) = v2 then + subset l1 l2 && subset r1 r2 + else if v1 < v2 then + subset N.(return @@ node ~left:l1 ~key:v1 ~right:empty ~h:0) l2 && subset r1 s2 + else + subset N.(return @@ node ~left:empty ~key:v1 ~right:r1 ~h:0) r2 && subset l1 s2 + + +let rec findOpt (x : elt) (n :t) = + match N.toOpt n with + | None -> None + | Some t (* Node(l, v, r, _) *) -> + let v = N.key t in + if x = v then Some v + else findOpt x N.(if x < v then (left t) else (right t)) + +let rec findAssert (x : elt) (n :t) = + match N.toOpt n with + | None -> [%assert "Not_found"] + | Some t (* Node(l, v, r, _) *) -> + let v = N.key t in + if x = v then Some v + else findAssert x N.(if x < v then (left t) else (right t)) + + +(* FIXME: use [sorted] attribute *) +let ofArray (xs : elt array) : t = + let result = ref N.empty in + for i = 0 to Array.length xs - 1 do + result := add (Bs_Array.unsafe_get xs i) !result + done ; + !result + + +(* +let of_sorted_list l = + let rec sub n l = + match n, l with + | 0, l -> Empty, l + | 1, x0 :: l -> Node (Empty, x0, Empty, 1), l + | 2, x0 :: x1 :: l -> Node (Node(Empty, x0, Empty, 1), x1, Empty, 2), l + | 3, x0 :: x1 :: x2 :: l -> + Node (Node(Empty, x0, Empty, 1), x1, Node(Empty, x2, Empty, 1), 2),l + | n, l -> + let nl = n / 2 in + let left, l = sub nl l in + match l with + | [] -> assert false + | mid :: l -> + let right, l = sub (n - nl - 1) l in + create left mid right, l + in + fst (sub (List.length l) l) +*) +(* +let of_list l = + match l with + | [] -> empty + | [x0] -> singleton x0 + | [x0; x1] -> add x1 (singleton x0) + | [x0; x1; x2] -> add x2 (add x1 (singleton x0)) + | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0))) + | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) + | _ -> of_sorted_list (List.sort_uniq Pervasives.compare l) +*) + + + +external unsafeCoerce : 'a Js.null -> 'a = "%identity" + +(* + L rotation, return root node +*) +let rotateWithLeftChild k2 = + let k1 = unsafeCoerce (N.left k2) in + N.(leftSet k2 (right k1)); + N.(rightSet k1 (return k2 )); + let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in + N.(hSet k2 + (Pervasives.max hlk2 hrk2 + 1)); + let hlk1, hk2 = N.(height (left k1), (h k2)) in + N.(hSet k1 (Pervasives.max hlk1 hk2 + 1)); + k1 +(* right rotation *) +let rotateWithRightChild k1 = + let k2 = unsafeCoerce (N.right k1) in + N.(rightSet k1 (left k2)); + N.(leftSet k2 (return k1)); + let hlk1, hrk1 = N.((height (left k1)), (height (right k1))) in + N.(hSet k1 (Pervasives.max hlk1 hrk1 + 1)); + let hrk2, hk1 = N.(height (right k2), (h k1)) in + N.(hSet k2 (Pervasives.max hrk2 hk1 + 1)); + k2 + +(* + double l rotation +*) +let doubleWithLeftChild k3 = + let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in + N.(leftSet k3 (return v )); + rotateWithLeftChild k3 + +let doubleWithRightChild k2 = + let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in + N.(rightSet k2 (return v)); + rotateWithRightChild k2 +type key = int + +let rec addMutate (t : _ t0) (x : key)= + match N.toOpt t with + | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) + | Some nt -> + let k = N.key nt in + if x = k then t + else + begin + let l, r = N.(left nt, right nt) in + let t = + (if x < k then + begin + N.leftSet nt (addMutate l x); + (if N.height l > 2 + N.height r then + (if x < N.key (unsafeCoerce l) then + rotateWithLeftChild nt + else + doubleWithLeftChild nt ) + else nt ) + end + else + begin + N.rightSet nt (addMutate r x); + (if N.height r > 2 + N.height l then + (if N.key (unsafeCoerce r) < x then + rotateWithRightChild nt + else + doubleWithRightChild nt + ) else + nt + ) + end + ) in + let hlt, hrt = N.(height (left t),(height (right t))) in + N.hSet t + N.(Pervasives.max hlt hrt + 1); + N.return t + end \ No newline at end of file diff --git a/jscomp/others/set.cppo.ml b/jscomp/others/set.cppo.ml index 36a4addd6ce..4a1177e68ed 100644 --- a/jscomp/others/set.cppo.ml +++ b/jscomp/others/set.cppo.ml @@ -20,22 +20,6 @@ type ('elt, 'id) enumeration0 = type t = (elt, unit) t0 type enumeration = (elt,unit) enumeration0 -let empty = N.empty0 -let isEmpty = N.isEmpty0 -let singleton = N.singleton0 -let min = N.min0 -let max = N.max0 -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 cardinal = N.cardinal0 -let elements = N.elements0 -let toArray = N.toArray0 -let checkInvariant = N.checkInvariant -(* Insertion of one element *) let rec add (x : elt) (t : t) : t = match N.toOpt t with @@ -79,12 +63,12 @@ let rec split (x : elt) (t : t) : t * bool * t = splitAux x n -let rec mem (x : elt) (t : t) = +let rec mem (t : t) (x : elt) = match N.toOpt t with | None -> false | Some n (* Node(l, v, r, _) *) -> let v = N.key n in - x = v || mem x N.(if x < v then (left n) else (right n)) + x = v || mem N.(if x < v then (left n) else (right n)) x let rec remove (x : elt) (t : t) : t = match N.toOpt t with @@ -238,3 +222,84 @@ let of_list l = | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) | _ -> of_sorted_list (List.sort_uniq Pervasives.compare l) *) + + + +external unsafeCoerce : 'a Js.null -> 'a = "%identity" + +(* + L rotation, return root node +*) +let rotateWithLeftChild k2 = + let k1 = unsafeCoerce (N.left k2) in + N.(leftSet k2 (right k1)); + N.(rightSet k1 (return k2 )); + let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in + N.(hSet k2 + (Pervasives.max hlk2 hrk2 + 1)); + let hlk1, hk2 = N.(height (left k1), (h k2)) in + N.(hSet k1 (Pervasives.max hlk1 hk2 + 1)); + k1 +(* right rotation *) +let rotateWithRightChild k1 = + let k2 = unsafeCoerce (N.right k1) in + N.(rightSet k1 (left k2)); + N.(leftSet k2 (return k1)); + let hlk1, hrk1 = N.((height (left k1)), (height (right k1))) in + N.(hSet k1 (Pervasives.max hlk1 hrk1 + 1)); + let hrk2, hk1 = N.(height (right k2), (h k1)) in + N.(hSet k2 (Pervasives.max hrk2 hk1 + 1)); + k2 + +(* + double l rotation +*) +let doubleWithLeftChild k3 = + let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in + N.(leftSet k3 (return v )); + rotateWithLeftChild k3 + +let doubleWithRightChild k2 = + let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in + N.(rightSet k2 (return v)); + rotateWithRightChild k2 +type key = int + +let rec addMutate (t : _ t0) (x : key)= + match N.toOpt t with + | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) + | Some nt -> + let k = N.key nt in + if x = k then t + else + begin + let l, r = N.(left nt, right nt) in + let t = + (if x < k then + begin + N.leftSet nt (addMutate l x); + (if N.height l > 2 + N.height r then + (if x < N.key (unsafeCoerce l) then + rotateWithLeftChild nt + else + doubleWithLeftChild nt ) + else nt ) + end + else + begin + N.rightSet nt (addMutate r x); + (if N.height r > 2 + N.height l then + (if N.key (unsafeCoerce r) < x then + rotateWithRightChild nt + else + doubleWithRightChild nt + ) else + nt + ) + end + ) in + let hlt, hrt = N.(height (left t),(height (right t))) in + N.hSet t + N.(Pervasives.max hlt hrt + 1); + N.return t + end \ No newline at end of file diff --git a/jscomp/others/set.cppo.mli b/jscomp/others/set.cppo.mli index 6232b3b81ad..7c73ee6d895 100644 --- a/jscomp/others/set.cppo.mli +++ b/jscomp/others/set.cppo.mli @@ -17,7 +17,7 @@ val empty: t val isEmpty: t -> bool (** Test whether a set is empty or not. *) -val mem: elt -> t -> bool +val mem: t -> elt -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) val add: elt -> t -> t @@ -79,8 +79,7 @@ val partition: (elt -> bool [@bs]) -> t -> t * t predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) -val cardinal: t -> int -(** Return the number of elements of a set. *) +val length: t -> int val elements: t -> elt list (** Return the list of all elements of the given set. diff --git a/jscomp/test/.depend b/jscomp/test/.depend index d3d42d32b46..c6293b958ed 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -100,8 +100,8 @@ bs_list_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj bs_map_int_test.cmj : mt.cmj ../others/bs.cmj bs_map_test.cmj : ../runtime/js.cmj ../others/bs.cmj bs_min_max_test.cmj : ../stdlib/pervasives.cmj mt.cmj -bs_mutable_set_test.cmj : ../runtime/js.cmj \ - ../others/bs_internalMutableAVLSet.cmj +bs_mutable_set_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj \ + array_data_util.cmj bs_node_string_buffer_test.cmj : ../others/node.cmj ../runtime/js.cmj bs_qualified.cmj : ../runtime/js.cmj bs_queue_test.cmj : ../runtime/js.cmj ../others/bs.cmj diff --git a/jscomp/test/bs_map_test.js b/jscomp/test/bs_map_test.js index 607f3a3c306..c54d2abeaad 100644 --- a/jscomp/test/bs_map_test.js +++ b/jscomp/test/bs_map_test.js @@ -66,7 +66,7 @@ var cmp$2 = m_dict$1[/* cmp */0]; var data$1 = v.data; for(var i$1 = 0; i$1 <= 100000; ++i$1){ - data$1 = Bs_Set.add0(cmp$2, i$1, data$1); + data$1 = Bs_Set.add0(cmp$2, data$1, i$1); } console.log(data$1); diff --git a/jscomp/test/bs_map_test.ml b/jscomp/test/bs_map_test.ml index 55345dc227a..9ca4099f54d 100644 --- a/jscomp/test/bs_map_test.ml +++ b/jscomp/test/bs_map_test.ml @@ -73,7 +73,7 @@ let () = let cmp = M.cmp in let data = ref (B.data v) in for i = 0 to count do - data := Bs.Set.add0 ~cmp i !data + data := Bs.Set.add0 ~cmp !data i done ; Js.log !data (* { v with data = !data} *) \ No newline at end of file diff --git a/jscomp/test/bs_mutable_set_test.js b/jscomp/test/bs_mutable_set_test.js index 8797b51c200..af856c1aa6b 100644 --- a/jscomp/test/bs_mutable_set_test.js +++ b/jscomp/test/bs_mutable_set_test.js @@ -1,22 +1,48 @@ 'use strict'; -var Bs_internalMutableAVLSet = require("../../lib/js/bs_internalMutableAVLSet.js"); +var Mt = require("./mt.js"); +var Bs_Range = require("../../lib/js/bs_Range.js"); +var Bs_SetIntM = require("../../lib/js/bs_SetIntM.js"); -var v = Bs_internalMutableAVLSet.empty; +var suites = [/* [] */0]; -console.time("bs_mutable_set_test.ml 11"); +var test_id = [0]; -for(var i = 0; i <= 1000000; ++i){ - v = Bs_internalMutableAVLSet.add(i, v); +function eq(loc, x, y) { + return Mt.eq_suites(test_id, suites, loc, x, y); } -console.timeEnd("bs_mutable_set_test.ml 11"); +function b(loc, x) { + return Mt.bool_suites(test_id, suites, loc, x); +} + +var v = [Bs_SetIntM.empty]; + +for(var i = 0; i <= 100000; ++i){ + v[0] = Bs_SetIntM.add(v[0], i); +} -console.log(Bs_internalMutableAVLSet.checkInvariant(v)); +b("File \"bs_mutable_set_test.ml\", line 19, characters 4-11", Bs_SetIntM.checkInvariant(v[0])); -console.log(Bs_internalMutableAVLSet.cardinal(v)); +b("File \"bs_mutable_set_test.ml\", line 20, characters 4-11", Bs_Range.forAll(0, 100000, (function (i) { + return Bs_SetIntM.mem(v[0], i); + }))); + +console.log(Bs_SetIntM.length(v[0])); + +Mt.from_pair_suites("bs_mutable_set_test.ml", suites[0]); var N = 0; +var I = 0; + +var R = 0; + +exports.suites = suites; +exports.test_id = test_id; +exports.eq = eq; +exports.b = b; exports.N = N; +exports.I = I; +exports.R = R; /* Not a pure module */ diff --git a/jscomp/test/bs_mutable_set_test.ml b/jscomp/test/bs_mutable_set_test.ml index f412d043d54..4c7ebd4f74c 100644 --- a/jscomp/test/bs_mutable_set_test.ml +++ b/jscomp/test/bs_mutable_set_test.ml @@ -1,16 +1,26 @@ +let suites : Mt.pair_suites ref = ref [] +let test_id = ref 0 +let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y +let b loc x = Mt.bool_suites ~test_id ~suites loc x +module N = Bs.SetIntM -module N = Bs_internalMutableAVLSet - - +module I = Array_data_util +module R = Bs.Range let () = let v = ref N.empty in - [%time for i = 0 to 1_000_000 do + for i = 0 to 1_00_000 do (* [%assert (N.checkInvariant !v)]; *) - v := N.add i !v - done] ; - Js.log (N.checkInvariant !v); - Js.log (N.cardinal !v) + v := N.add !v i + done ; + b __LOC__ (N.checkInvariant !v); + b __LOC__ @@ R.forAll 0 1_00_000 (fun [@bs] i -> + N.mem !v i + ); + Js.log (N.length !v) + + +;; Mt.from_pair_suites __FILE__ !suites \ No newline at end of file diff --git a/jscomp/test/bs_set_bench.js b/jscomp/test/bs_set_bench.js index 808b04a6d97..3e30ccb4944 100644 --- a/jscomp/test/bs_set_bench.js +++ b/jscomp/test/bs_set_bench.js @@ -30,7 +30,7 @@ function bench() { data = Bs_SetInt.remove(i$2, data); } console.timeEnd("bs_set_bench.ml 14"); - if (Bs_SetInt.cardinal(data)) { + if (Bs_SetInt.length(data)) { throw [ Caml_builtin_exceptions.assert_failure, [ diff --git a/jscomp/test/bs_set_bench.ml b/jscomp/test/bs_set_bench.ml index e65f7a4acc7..7f29aa771cc 100644 --- a/jscomp/test/bs_set_bench.ml +++ b/jscomp/test/bs_set_bench.ml @@ -14,7 +14,7 @@ let bench () = [%time for i = 0 to count do data := Bs.SetInt.remove i !data done ]; - assert (Bs.SetInt.cardinal !data = 0) + assert (Bs.SetInt.length !data = 0) diff --git a/jscomp/test/class8_test.js b/jscomp/test/class8_test.js index 4c3c9346e6c..06f58061a9b 100644 --- a/jscomp/test/class8_test.js +++ b/jscomp/test/class8_test.js @@ -1,7 +1,6 @@ 'use strict'; var Mt = require("./mt.js"); -var Block = require("../../lib/js/block.js"); var Curry = require("../../lib/js/curry.js"); var Caml_obj = require("../../lib/js/caml_obj.js"); var Caml_oo_curry = require("../../lib/js/caml_oo_curry.js"); @@ -20,20 +19,7 @@ var suites = [/* [] */0]; var test_id = [0]; function eq(loc, x, y) { - test_id[0] = test_id[0] + 1 | 0; - suites[0] = /* :: */[ - /* tuple */[ - loc + (" id " + test_id[0]), - (function () { - return /* Eq */Block.__(0, [ - x, - y - ]); - }) - ], - suites[0] - ]; - return /* () */0; + return Mt.eq_suites(test_id, suites, loc, x, y); } function comparable_001($$class) { @@ -113,11 +99,11 @@ function min(x, y) { var tmp = min(Curry._2(money[0], 0, 1.0), Curry._2(money[0], 0, 3.0)); -eq("File \"class8_test.ml\", line 34, characters 5-12", 1, Caml_oo_curry.js1(834174833, 3, tmp)); +eq("File \"class8_test.ml\", line 30, characters 5-12", 1, Caml_oo_curry.js1(834174833, 3, tmp)); var tmp$1 = min(Curry._2(money2[0], 0, 5.0), Curry._2(money2[0], 0, 3)); -eq("File \"class8_test.ml\", line 39, characters 5-12", 3, Caml_oo_curry.js1(834174833, 4, tmp$1)); +eq("File \"class8_test.ml\", line 35, characters 5-12", 3, Caml_oo_curry.js1(834174833, 4, tmp$1)); Mt.from_pair_suites("class8_test.ml", suites[0]); diff --git a/jscomp/test/class8_test.ml b/jscomp/test/class8_test.ml index 9192552b694..518cd0c3211 100644 --- a/jscomp/test/class8_test.ml +++ b/jscomp/test/class8_test.ml @@ -1,10 +1,6 @@ let suites : Mt.pair_suites ref = ref [] let test_id = ref 0 -let eq loc x y = - incr test_id ; - suites := - (loc ^" id " ^ (string_of_int !test_id), (fun _ -> Mt.Eq(x,y))) :: !suites - +let eq loc x y = Mt.eq_suites ~test_id ~suites loc x y class virtual comparable = diff --git a/lib/js/bs.js b/lib/js/bs.js index 75ebc947dba..2fa7be66b1f 100644 --- a/lib/js/bs.js +++ b/lib/js/bs.js @@ -39,6 +39,8 @@ var MapString = 0; var SetInt = 0; +var SetIntM = 0; + var SetString = 0; var List = 0; @@ -62,6 +64,7 @@ exports.$$Set = $$Set; exports.MapInt = MapInt; exports.MapString = MapString; exports.SetInt = SetInt; +exports.SetIntM = SetIntM; exports.SetString = SetString; exports.List = List; /* No side effect */ diff --git a/lib/js/bs_Set.js b/lib/js/bs_Set.js index c4c6b7a57d6..cbf8c88f242 100644 --- a/lib/js/bs_Set.js +++ b/lib/js/bs_Set.js @@ -2,7 +2,7 @@ var Bs_internalAVLset = require("./bs_internalAVLset.js"); -function add0(cmp, x, t) { +function add0(cmp, t, x) { if (t !== null) { var l = t.left; var v = t.key; @@ -10,9 +10,9 @@ function add0(cmp, x, t) { var c = cmp(x, v); if (c) { if (c < 0) { - return Bs_internalAVLset.bal(add0(cmp, x, l), v, r); + return Bs_internalAVLset.bal(add0(cmp, l, x), v, r); } else { - return Bs_internalAVLset.bal(l, v, add0(cmp, x, r)); + return Bs_internalAVLset.bal(l, v, add0(cmp, r, x)); } } else { return t; @@ -129,7 +129,7 @@ function union0(cmp, s1, s2) { var h2 = s2.h; if (h1 >= h2) { if (h2 === 1) { - return add0(cmp, s2.key, s1); + return add0(cmp, s1, s2.key); } else { var l1 = s1.left; var v1 = s1.key; @@ -138,7 +138,7 @@ function union0(cmp, s1, s2) { return Bs_internalAVLset.join(union0(cmp, l1, match[0]), v1, union0(cmp, r1, match[2])); } } else if (h1 === 1) { - return add0(cmp, s1.key, s2); + return add0(cmp, s2, s1.key); } else { var l2 = s2.left; var v2 = s2.key; @@ -190,7 +190,7 @@ function eq0(cmp, s1, s2) { function ofArray0(cmp, xs) { var result = null; for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ - result = add0(cmp, xs[i], result); + result = add0(cmp, result, xs[i]); } return result; } @@ -219,12 +219,12 @@ function mem(e, m) { return mem0(dict[/* cmp */0], e, data); } -function add(e, m) { +function add(m, e) { var dict = m.dict; var data = m.data; return { dict: dict, - data: add0(dict[/* cmp */0], e, data) + data: add0(dict[/* cmp */0], data, e) }; } @@ -309,8 +309,8 @@ function partition(f, m) { ]; } -function cardinal(m) { - return Bs_internalAVLset.cardinal0(m.data); +function length(m) { + return Bs_internalAVLset.length0(m.data); } function elements(m) { @@ -364,7 +364,7 @@ var filter0 = Bs_internalAVLset.filter0; var partition0 = Bs_internalAVLset.partition0; -var cardinal0 = Bs_internalAVLset.cardinal0; +var length0 = Bs_internalAVLset.length0; var elements0 = Bs_internalAVLset.elements0; @@ -406,8 +406,8 @@ exports.filter0 = filter0; exports.filter = filter; exports.partition0 = partition0; exports.partition = partition; -exports.cardinal0 = cardinal0; -exports.cardinal = cardinal; +exports.length0 = length0; +exports.length = length; exports.elements0 = elements0; exports.elements = elements; exports.toArray0 = toArray0; diff --git a/lib/js/bs_SetInt.js b/lib/js/bs_SetInt.js index 487bb3ab7d1..ba8f59b61ae 100644 --- a/lib/js/bs_SetInt.js +++ b/lib/js/bs_SetInt.js @@ -1,335 +1,31 @@ 'use strict'; var Bs_internalAVLset = require("./bs_internalAVLset.js"); +var Bs_internalSetInt = require("./bs_internalSetInt.js"); -function add(x, t) { - if (t !== null) { - var v = t.key; - if (x === v) { - return t; - } else if (x < v) { - return Bs_internalAVLset.bal(add(x, t.left), v, t.right); - } else { - return Bs_internalAVLset.bal(t.left, v, add(x, t.right)); - } - } else { - return { - left: null, - key: x, - right: null, - h: 1 - }; - } -} - -function splitAux(x, n) { - var l = n.left; - var v = n.key; - var r = n.right; - if (x === v) { - return /* tuple */[ - l, - /* true */1, - r - ]; - } else if (x < v) { - if (l !== null) { - var match = splitAux(x, l); - return /* tuple */[ - match[0], - match[1], - Bs_internalAVLset.join(match[2], v, r) - ]; - } else { - return /* tuple */[ - null, - /* false */0, - n - ]; - } - } else if (r !== null) { - var match$1 = splitAux(x, r); - return /* tuple */[ - Bs_internalAVLset.join(l, v, match$1[0]), - match$1[1], - match$1[2] - ]; - } else { - return /* tuple */[ - n, - /* false */0, - null - ]; - } -} - -function split(x, t) { - if (t !== null) { - return splitAux(x, t); - } else { - return /* tuple */[ - null, - /* false */0, - null - ]; - } -} +var empty = Bs_internalAVLset.empty0; -function mem(x, _t) { - while(true) { - var t = _t; - if (t !== null) { - var v = t.key; - if (x === v) { - return /* true */1; - } else { - _t = x < v ? t.left : t.right; - continue ; - - } - } else { - return /* false */0; - } - }; -} +var isEmpty = Bs_internalAVLset.isEmpty0; -function remove(x, t) { - if (t !== null) { - var l = t.left; - var v = t.key; - var r = t.right; - if (x === v) { - return Bs_internalAVLset.merge(l, r); - } else if (x < v) { - return Bs_internalAVLset.bal(remove(x, l), v, r); - } else { - return Bs_internalAVLset.bal(l, v, remove(x, r)); - } - } else { - return t; - } -} +var mem = Bs_internalSetInt.mem; -function union(s1, s2) { - if (s1 !== null) { - if (s2 !== null) { - var h1 = s1.h; - var h2 = s2.h; - if (h1 >= h2) { - if (h2 === 1) { - return add(s2.key, s1); - } else { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var match = splitAux(v1, s2); - return Bs_internalAVLset.join(union(l1, match[0]), v1, union(r1, match[2])); - } - } else if (h1 === 1) { - return add(s1.key, s2); - } else { - var l2 = s2.left; - var v2 = s2.key; - var r2 = s2.right; - var match$1 = splitAux(v2, s1); - return Bs_internalAVLset.join(union(match$1[0], l2), v2, union(match$1[2], r2)); - } - } else { - return s1; - } - } else { - return s2; - } -} +var add = Bs_internalSetInt.add; -function inter(s1, s2) { - if (s1 !== null) { - if (s2 !== null) { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var match = splitAux(v1, s2); - var l2 = match[0]; - if (match[1] !== 0) { - return Bs_internalAVLset.join(inter(l1, l2), v1, inter(r1, match[2])); - } else { - return Bs_internalAVLset.concat(inter(l1, l2), inter(r1, match[2])); - } - } else { - return s2; - } - } else { - return s1; - } -} +var singleton = Bs_internalAVLset.singleton0; -function diff(s1, s2) { - if (s1 !== null) { - if (s2 !== null) { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var match = splitAux(v1, s2); - var l2 = match[0]; - if (match[1] !== 0) { - return Bs_internalAVLset.concat(diff(l1, l2), diff(r1, match[2])); - } else { - return Bs_internalAVLset.join(diff(l1, l2), v1, diff(r1, match[2])); - } - } else { - return s1; - } - } else { - return s1; - } -} +var remove = Bs_internalSetInt.remove; -function cmp(s1, s2) { - var _e1 = Bs_internalAVLset.cons_enum(s1, /* End */0); - var _e2 = Bs_internalAVLset.cons_enum(s2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - var v2 = e2[0]; - var v1 = e1[0]; - if (v1 !== v2) { - if (v1 < v2) { - return -1; - } else { - return 1; - } - } else { - _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); - continue ; - - } - } else { - return 1; - } - } else if (e2) { - return -1; - } else { - return 0; - } - }; -} +var union = Bs_internalSetInt.union; -function eq(s1, s2) { - var _e1 = Bs_internalAVLset.cons_enum(s1, /* End */0); - var _e2 = Bs_internalAVLset.cons_enum(s2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (e1[0] === e2[0]) { - _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); - continue ; - - } else { - return /* false */0; - } - } else { - return /* false */0; - } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; -} +var inter = Bs_internalSetInt.inter; -function subset(_s1, _s2) { - while(true) { - var s2 = _s2; - var s1 = _s1; - if (s1 !== null) { - if (s2 !== null) { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var l2 = s2.left; - var v2 = s2.key; - var r2 = s2.right; - if (v1 === v2) { - if (subset(l1, l2)) { - _s2 = r2; - _s1 = r1; - continue ; - - } else { - return /* false */0; - } - } else if (v1 < v2) { - if (subset({ - left: l1, - key: v1, - right: null, - h: 0 - }, l2)) { - _s1 = r1; - continue ; - - } else { - return /* false */0; - } - } else if (subset({ - left: null, - key: v1, - right: r1, - h: 0 - }, r2)) { - _s1 = l1; - continue ; - - } else { - return /* false */0; - } - } else { - return /* false */0; - } - } else { - return /* true */1; - } - }; -} +var diff = Bs_internalSetInt.diff; -function findOpt(x, _n) { - while(true) { - var n = _n; - if (n !== null) { - var v = n.key; - if (x === v) { - return /* Some */[v]; - } else { - _n = x < v ? n.left : n.right; - continue ; - - } - } else { - return /* None */0; - } - }; -} +var cmp = Bs_internalSetInt.cmp; -function ofArray(xs) { - var result = null; - for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ - result = add(xs[i], result); - } - return result; -} +var eq = Bs_internalSetInt.eq; -var empty = Bs_internalAVLset.empty0; - -var isEmpty = Bs_internalAVLset.isEmpty0; - -var singleton = Bs_internalAVLset.singleton0; +var subset = Bs_internalSetInt.subset; var iter = Bs_internalAVLset.iter0; @@ -343,7 +39,7 @@ var filter = Bs_internalAVLset.filter0; var partition = Bs_internalAVLset.partition0; -var cardinal = Bs_internalAVLset.cardinal0; +var length = Bs_internalAVLset.length0; var elements = Bs_internalAVLset.elements0; @@ -353,6 +49,12 @@ var min = Bs_internalAVLset.min0; var max = Bs_internalAVLset.max0; +var split = Bs_internalSetInt.split; + +var findOpt = Bs_internalSetInt.findOpt; + +var ofArray = Bs_internalSetInt.ofArray; + var checkInvariant = Bs_internalAVLset.checkInvariant; exports.empty = empty; @@ -373,7 +75,7 @@ exports.forAll = forAll; exports.exists = exists; exports.filter = filter; exports.partition = partition; -exports.cardinal = cardinal; +exports.length = length; exports.elements = elements; exports.toArray = toArray; exports.min = min; diff --git a/lib/js/bs_SetIntM.js b/lib/js/bs_SetIntM.js new file mode 100644 index 00000000000..d1ab0a5e7a4 --- /dev/null +++ b/lib/js/bs_SetIntM.js @@ -0,0 +1,27 @@ +'use strict'; + +var Bs_internalAVLset = require("./bs_internalAVLset.js"); +var Bs_internalSetInt = require("./bs_internalSetInt.js"); + +var empty = Bs_internalAVLset.empty0; + +var isEmpty = Bs_internalAVLset.isEmpty0; + +var mem = Bs_internalSetInt.mem; + +var add = Bs_internalSetInt.addMutate; + +var singleton = Bs_internalAVLset.singleton0; + +var checkInvariant = Bs_internalAVLset.checkInvariant; + +var length = Bs_internalAVLset.length0; + +exports.empty = empty; +exports.isEmpty = isEmpty; +exports.mem = mem; +exports.add = add; +exports.singleton = singleton; +exports.checkInvariant = checkInvariant; +exports.length = length; +/* No side effect */ diff --git a/lib/js/bs_SetString.js b/lib/js/bs_SetString.js index 487bb3ab7d1..2d99eb431a6 100644 --- a/lib/js/bs_SetString.js +++ b/lib/js/bs_SetString.js @@ -1,335 +1,31 @@ 'use strict'; var Bs_internalAVLset = require("./bs_internalAVLset.js"); +var Bs_internalSetString = require("./bs_internalSetString.js"); -function add(x, t) { - if (t !== null) { - var v = t.key; - if (x === v) { - return t; - } else if (x < v) { - return Bs_internalAVLset.bal(add(x, t.left), v, t.right); - } else { - return Bs_internalAVLset.bal(t.left, v, add(x, t.right)); - } - } else { - return { - left: null, - key: x, - right: null, - h: 1 - }; - } -} - -function splitAux(x, n) { - var l = n.left; - var v = n.key; - var r = n.right; - if (x === v) { - return /* tuple */[ - l, - /* true */1, - r - ]; - } else if (x < v) { - if (l !== null) { - var match = splitAux(x, l); - return /* tuple */[ - match[0], - match[1], - Bs_internalAVLset.join(match[2], v, r) - ]; - } else { - return /* tuple */[ - null, - /* false */0, - n - ]; - } - } else if (r !== null) { - var match$1 = splitAux(x, r); - return /* tuple */[ - Bs_internalAVLset.join(l, v, match$1[0]), - match$1[1], - match$1[2] - ]; - } else { - return /* tuple */[ - n, - /* false */0, - null - ]; - } -} - -function split(x, t) { - if (t !== null) { - return splitAux(x, t); - } else { - return /* tuple */[ - null, - /* false */0, - null - ]; - } -} +var empty = Bs_internalAVLset.empty0; -function mem(x, _t) { - while(true) { - var t = _t; - if (t !== null) { - var v = t.key; - if (x === v) { - return /* true */1; - } else { - _t = x < v ? t.left : t.right; - continue ; - - } - } else { - return /* false */0; - } - }; -} +var isEmpty = Bs_internalAVLset.isEmpty0; -function remove(x, t) { - if (t !== null) { - var l = t.left; - var v = t.key; - var r = t.right; - if (x === v) { - return Bs_internalAVLset.merge(l, r); - } else if (x < v) { - return Bs_internalAVLset.bal(remove(x, l), v, r); - } else { - return Bs_internalAVLset.bal(l, v, remove(x, r)); - } - } else { - return t; - } -} +var mem = Bs_internalSetString.mem; -function union(s1, s2) { - if (s1 !== null) { - if (s2 !== null) { - var h1 = s1.h; - var h2 = s2.h; - if (h1 >= h2) { - if (h2 === 1) { - return add(s2.key, s1); - } else { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var match = splitAux(v1, s2); - return Bs_internalAVLset.join(union(l1, match[0]), v1, union(r1, match[2])); - } - } else if (h1 === 1) { - return add(s1.key, s2); - } else { - var l2 = s2.left; - var v2 = s2.key; - var r2 = s2.right; - var match$1 = splitAux(v2, s1); - return Bs_internalAVLset.join(union(match$1[0], l2), v2, union(match$1[2], r2)); - } - } else { - return s1; - } - } else { - return s2; - } -} +var add = Bs_internalSetString.add; -function inter(s1, s2) { - if (s1 !== null) { - if (s2 !== null) { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var match = splitAux(v1, s2); - var l2 = match[0]; - if (match[1] !== 0) { - return Bs_internalAVLset.join(inter(l1, l2), v1, inter(r1, match[2])); - } else { - return Bs_internalAVLset.concat(inter(l1, l2), inter(r1, match[2])); - } - } else { - return s2; - } - } else { - return s1; - } -} +var singleton = Bs_internalAVLset.singleton0; -function diff(s1, s2) { - if (s1 !== null) { - if (s2 !== null) { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var match = splitAux(v1, s2); - var l2 = match[0]; - if (match[1] !== 0) { - return Bs_internalAVLset.concat(diff(l1, l2), diff(r1, match[2])); - } else { - return Bs_internalAVLset.join(diff(l1, l2), v1, diff(r1, match[2])); - } - } else { - return s1; - } - } else { - return s1; - } -} +var remove = Bs_internalSetString.remove; -function cmp(s1, s2) { - var _e1 = Bs_internalAVLset.cons_enum(s1, /* End */0); - var _e2 = Bs_internalAVLset.cons_enum(s2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - var v2 = e2[0]; - var v1 = e1[0]; - if (v1 !== v2) { - if (v1 < v2) { - return -1; - } else { - return 1; - } - } else { - _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); - continue ; - - } - } else { - return 1; - } - } else if (e2) { - return -1; - } else { - return 0; - } - }; -} +var union = Bs_internalSetString.union; -function eq(s1, s2) { - var _e1 = Bs_internalAVLset.cons_enum(s1, /* End */0); - var _e2 = Bs_internalAVLset.cons_enum(s2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (e1[0] === e2[0]) { - _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); - continue ; - - } else { - return /* false */0; - } - } else { - return /* false */0; - } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; -} +var inter = Bs_internalSetString.inter; -function subset(_s1, _s2) { - while(true) { - var s2 = _s2; - var s1 = _s1; - if (s1 !== null) { - if (s2 !== null) { - var l1 = s1.left; - var v1 = s1.key; - var r1 = s1.right; - var l2 = s2.left; - var v2 = s2.key; - var r2 = s2.right; - if (v1 === v2) { - if (subset(l1, l2)) { - _s2 = r2; - _s1 = r1; - continue ; - - } else { - return /* false */0; - } - } else if (v1 < v2) { - if (subset({ - left: l1, - key: v1, - right: null, - h: 0 - }, l2)) { - _s1 = r1; - continue ; - - } else { - return /* false */0; - } - } else if (subset({ - left: null, - key: v1, - right: r1, - h: 0 - }, r2)) { - _s1 = l1; - continue ; - - } else { - return /* false */0; - } - } else { - return /* false */0; - } - } else { - return /* true */1; - } - }; -} +var diff = Bs_internalSetString.diff; -function findOpt(x, _n) { - while(true) { - var n = _n; - if (n !== null) { - var v = n.key; - if (x === v) { - return /* Some */[v]; - } else { - _n = x < v ? n.left : n.right; - continue ; - - } - } else { - return /* None */0; - } - }; -} +var cmp = Bs_internalSetString.cmp; -function ofArray(xs) { - var result = null; - for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ - result = add(xs[i], result); - } - return result; -} +var eq = Bs_internalSetString.eq; -var empty = Bs_internalAVLset.empty0; - -var isEmpty = Bs_internalAVLset.isEmpty0; - -var singleton = Bs_internalAVLset.singleton0; +var subset = Bs_internalSetString.subset; var iter = Bs_internalAVLset.iter0; @@ -343,7 +39,7 @@ var filter = Bs_internalAVLset.filter0; var partition = Bs_internalAVLset.partition0; -var cardinal = Bs_internalAVLset.cardinal0; +var length = Bs_internalAVLset.length0; var elements = Bs_internalAVLset.elements0; @@ -353,6 +49,12 @@ var min = Bs_internalAVLset.min0; var max = Bs_internalAVLset.max0; +var split = Bs_internalSetString.split; + +var findOpt = Bs_internalSetString.findOpt; + +var ofArray = Bs_internalSetString.ofArray; + var checkInvariant = Bs_internalAVLset.checkInvariant; exports.empty = empty; @@ -373,7 +75,7 @@ exports.forAll = forAll; exports.exists = exists; exports.filter = filter; exports.partition = partition; -exports.cardinal = cardinal; +exports.length = length; exports.elements = elements; exports.toArray = toArray; exports.min = min; diff --git a/lib/js/bs_internalAVLset.js b/lib/js/bs_internalAVLset.js index 05805dd954f..f71f4318028 100644 --- a/lib/js/bs_internalAVLset.js +++ b/lib/js/bs_internalAVLset.js @@ -342,7 +342,7 @@ function cardinalAux(n) { return (1 + sizeL | 0) + sizeR | 0; } -function cardinal0(n) { +function length0(n) { if (n !== null) { return cardinalAux(n); } else { @@ -458,7 +458,7 @@ exports.exists0 = exists0; exports.filter0 = filter0; exports.partition0 = partition0; exports.cardinalAux = cardinalAux; -exports.cardinal0 = cardinal0; +exports.length0 = length0; exports.elements_aux = elements_aux; exports.elements0 = elements0; exports.checkInvariant = checkInvariant; diff --git a/lib/js/bs_internalMutableAVLSet.js b/lib/js/bs_internalMutableAVLSet.js index 81a90b4c532..1e00c6a42f6 100644 --- a/lib/js/bs_internalMutableAVLSet.js +++ b/lib/js/bs_internalMutableAVLSet.js @@ -1,85 +1,12 @@ 'use strict'; var Bs_internalAVLset = require("./bs_internalAVLset.js"); - -function rotateWithLeftChild(k2) { - var k1 = k2.left; - k2.left = k1.right; - k1.right = k2; - var hlk2 = Bs_internalAVLset.height(k2.left); - var hrk2 = Bs_internalAVLset.height(k2.right); - k2.h = ( - hlk2 > hrk2 ? hlk2 : hrk2 - ) + 1 | 0; - var hlk1 = Bs_internalAVLset.height(k1.left); - var hk2 = k2.h; - k1.h = ( - hlk1 > hk2 ? hlk1 : hk2 - ) + 1 | 0; - return k1; -} - -function rotateWithRightChild(k1) { - var k2 = k1.right; - k1.right = k2.left; - k2.left = k1; - var hlk1 = Bs_internalAVLset.height(k1.left); - var hrk1 = Bs_internalAVLset.height(k1.right); - k1.h = ( - hlk1 > hrk1 ? hlk1 : hrk1 - ) + 1 | 0; - var hrk2 = Bs_internalAVLset.height(k2.right); - var hk1 = k1.h; - k2.h = ( - hrk2 > hk1 ? hrk2 : hk1 - ) + 1 | 0; - return k2; -} - -function doubleWithLeftChild(k3) { - var v = rotateWithLeftChild(k3.left); - k3.left = v; - return rotateWithLeftChild(k3); -} - -function doubleWithRightChild(k2) { - var v = rotateWithRightChild(k2.right); - k2.right = v; - return rotateWithRightChild(k2); -} - -function add(x, t) { - if (t !== null) { - var k = t.key; - if (x === k) { - return t; - } else { - var l = t.left; - var r = t.right; - var t$1 = x < k ? (t.left = add(x, l), Bs_internalAVLset.height(l) > (2 + Bs_internalAVLset.height(r) | 0) ? ( - x < l.key ? rotateWithLeftChild(t) : doubleWithLeftChild(t) - ) : t) : (t.right = add(x, r), Bs_internalAVLset.height(r) > (2 + Bs_internalAVLset.height(l) | 0) ? ( - r.key < x ? rotateWithRightChild(t) : doubleWithRightChild(t) - ) : t); - var hlt = Bs_internalAVLset.height(t$1.left); - var hrt = Bs_internalAVLset.height(t$1.right); - t$1.h = ( - hlt > hrt ? hlt : hrt - ) + 1 | 0; - return t$1; - } - } else { - return { - left: null, - key: x, - right: null, - h: 1 - }; - } -} +var Bs_internalSetInt = require("./bs_internalSetInt.js"); var N = 0; +var I = 0; + var empty = Bs_internalAVLset.empty0; var isEmpty = Bs_internalAVLset.isEmpty0; @@ -102,13 +29,40 @@ var filter = Bs_internalAVLset.filter0; var partition = Bs_internalAVLset.partition0; -var cardinal = Bs_internalAVLset.cardinal0; +var length = Bs_internalAVLset.length0; var elements = Bs_internalAVLset.elements0; +var toArray = Bs_internalAVLset.toArray0; + var checkInvariant = Bs_internalAVLset.checkInvariant; +var add = Bs_internalSetInt.addMutate; + +var ofArray = Bs_internalSetInt.ofArray; + +var cmp = Bs_internalSetInt.cmp; + +var diff = Bs_internalSetInt.diff; + +var eq = Bs_internalSetInt.eq; + +var findOpt = Bs_internalSetInt.findOpt; + +var split = Bs_internalSetInt.split; + +var subset = Bs_internalSetInt.subset; + +var inter = Bs_internalSetInt.inter; + +var union = Bs_internalSetInt.union; + +var remove = Bs_internalSetInt.remove; + +var mem = Bs_internalSetInt.mem; + exports.N = N; +exports.I = I; exports.empty = empty; exports.isEmpty = isEmpty; exports.singleton = singleton; @@ -120,12 +74,20 @@ exports.forAll = forAll; exports.exists = exists; exports.filter = filter; exports.partition = partition; -exports.cardinal = cardinal; +exports.length = length; exports.elements = elements; +exports.toArray = toArray; exports.checkInvariant = checkInvariant; -exports.rotateWithLeftChild = rotateWithLeftChild; -exports.rotateWithRightChild = rotateWithRightChild; -exports.doubleWithLeftChild = doubleWithLeftChild; -exports.doubleWithRightChild = doubleWithRightChild; exports.add = add; +exports.ofArray = ofArray; +exports.cmp = cmp; +exports.diff = diff; +exports.eq = eq; +exports.findOpt = findOpt; +exports.split = split; +exports.subset = subset; +exports.inter = inter; +exports.union = union; +exports.remove = remove; +exports.mem = mem; /* No side effect */ diff --git a/lib/js/bs_internalSetInt.js b/lib/js/bs_internalSetInt.js new file mode 100644 index 00000000000..870afdeb04f --- /dev/null +++ b/lib/js/bs_internalSetInt.js @@ -0,0 +1,450 @@ +'use strict'; + +var Bs_internalAVLset = require("./bs_internalAVLset.js"); + +function add(x, t) { + if (t !== null) { + var v = t.key; + if (x === v) { + return t; + } else if (x < v) { + return Bs_internalAVLset.bal(add(x, t.left), v, t.right); + } else { + return Bs_internalAVLset.bal(t.left, v, add(x, t.right)); + } + } else { + return { + left: null, + key: x, + right: null, + h: 1 + }; + } +} + +function splitAux(x, n) { + var l = n.left; + var v = n.key; + var r = n.right; + if (x === v) { + return /* tuple */[ + l, + /* true */1, + r + ]; + } else if (x < v) { + if (l !== null) { + var match = splitAux(x, l); + return /* tuple */[ + match[0], + match[1], + Bs_internalAVLset.join(match[2], v, r) + ]; + } else { + return /* tuple */[ + null, + /* false */0, + n + ]; + } + } else if (r !== null) { + var match$1 = splitAux(x, r); + return /* tuple */[ + Bs_internalAVLset.join(l, v, match$1[0]), + match$1[1], + match$1[2] + ]; + } else { + return /* tuple */[ + n, + /* false */0, + null + ]; + } +} + +function split(x, t) { + if (t !== null) { + return splitAux(x, t); + } else { + return /* tuple */[ + null, + /* false */0, + null + ]; + } +} + +function mem(_t, x) { + while(true) { + var t = _t; + if (t !== null) { + var v = t.key; + if (x === v) { + return /* true */1; + } else { + _t = x < v ? t.left : t.right; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function remove(x, t) { + if (t !== null) { + var l = t.left; + var v = t.key; + var r = t.right; + if (x === v) { + return Bs_internalAVLset.merge(l, r); + } else if (x < v) { + return Bs_internalAVLset.bal(remove(x, l), v, r); + } else { + return Bs_internalAVLset.bal(l, v, remove(x, r)); + } + } else { + return t; + } +} + +function union(s1, s2) { + if (s1 !== null) { + if (s2 !== null) { + var h1 = s1.h; + var h2 = s2.h; + if (h1 >= h2) { + if (h2 === 1) { + return add(s2.key, s1); + } else { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var match = splitAux(v1, s2); + return Bs_internalAVLset.join(union(l1, match[0]), v1, union(r1, match[2])); + } + } else if (h1 === 1) { + return add(s1.key, s2); + } else { + var l2 = s2.left; + var v2 = s2.key; + var r2 = s2.right; + var match$1 = splitAux(v2, s1); + return Bs_internalAVLset.join(union(match$1[0], l2), v2, union(match$1[2], r2)); + } + } else { + return s1; + } + } else { + return s2; + } +} + +function inter(s1, s2) { + if (s1 !== null) { + if (s2 !== null) { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var match = splitAux(v1, s2); + var l2 = match[0]; + if (match[1] !== 0) { + return Bs_internalAVLset.join(inter(l1, l2), v1, inter(r1, match[2])); + } else { + return Bs_internalAVLset.concat(inter(l1, l2), inter(r1, match[2])); + } + } else { + return s2; + } + } else { + return s1; + } +} + +function diff(s1, s2) { + if (s1 !== null) { + if (s2 !== null) { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var match = splitAux(v1, s2); + var l2 = match[0]; + if (match[1] !== 0) { + return Bs_internalAVLset.concat(diff(l1, l2), diff(r1, match[2])); + } else { + return Bs_internalAVLset.join(diff(l1, l2), v1, diff(r1, match[2])); + } + } else { + return s1; + } + } else { + return s1; + } +} + +function compare_aux(_e1, _e2) { + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var v2 = e2[0]; + var v1 = e1[0]; + if (v1 !== v2) { + if (v1 < v2) { + return -1; + } else { + return 1; + } + } else { + _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); + _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); + continue ; + + } + } else { + return 1; + } + } else if (e2) { + return -1; + } else { + return 0; + } + }; +} + +function cmp(s1, s2) { + return compare_aux(Bs_internalAVLset.cons_enum(s1, /* End */0), Bs_internalAVLset.cons_enum(s2, /* End */0)); +} + +function eq_aux(_e1, _e2) { + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + if (e1[0] === e2[0]) { + _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); + _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); + continue ; + + } else { + return /* false */0; + } + } else { + return /* false */0; + } + } else if (e2) { + return /* false */0; + } else { + return /* true */1; + } + }; +} + +function eq(s1, s2) { + return eq_aux(Bs_internalAVLset.cons_enum(s1, /* End */0), Bs_internalAVLset.cons_enum(s2, /* End */0)); +} + +function subset(_s1, _s2) { + while(true) { + var s2 = _s2; + var s1 = _s1; + if (s1 !== null) { + if (s2 !== null) { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var l2 = s2.left; + var v2 = s2.key; + var r2 = s2.right; + if (v1 === v2) { + if (subset(l1, l2)) { + _s2 = r2; + _s1 = r1; + continue ; + + } else { + return /* false */0; + } + } else if (v1 < v2) { + if (subset({ + left: l1, + key: v1, + right: null, + h: 0 + }, l2)) { + _s1 = r1; + continue ; + + } else { + return /* false */0; + } + } else if (subset({ + left: null, + key: v1, + right: r1, + h: 0 + }, r2)) { + _s1 = l1; + continue ; + + } else { + return /* false */0; + } + } else { + return /* false */0; + } + } else { + return /* true */1; + } + }; +} + +function findOpt(x, _n) { + while(true) { + var n = _n; + if (n !== null) { + var v = n.key; + if (x === v) { + return /* Some */[v]; + } else { + _n = x < v ? n.left : n.right; + continue ; + + } + } else { + return /* None */0; + } + }; +} + +function findAssert(x, _n) { + while(true) { + var n = _n; + if (n !== null) { + var v = n.key; + if (x === v) { + return /* Some */[v]; + } else { + _n = x < v ? n.left : n.right; + continue ; + + } + } else { + throw new Error("Not_found"); + } + }; +} + +function ofArray(xs) { + var result = null; + for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ + result = add(xs[i], result); + } + return result; +} + +function rotateWithLeftChild(k2) { + var k1 = k2.left; + k2.left = k1.right; + k1.right = k2; + var hlk2 = Bs_internalAVLset.height(k2.left); + var hrk2 = Bs_internalAVLset.height(k2.right); + k2.h = ( + hlk2 > hrk2 ? hlk2 : hrk2 + ) + 1 | 0; + var hlk1 = Bs_internalAVLset.height(k1.left); + var hk2 = k2.h; + k1.h = ( + hlk1 > hk2 ? hlk1 : hk2 + ) + 1 | 0; + return k1; +} + +function rotateWithRightChild(k1) { + var k2 = k1.right; + k1.right = k2.left; + k2.left = k1; + var hlk1 = Bs_internalAVLset.height(k1.left); + var hrk1 = Bs_internalAVLset.height(k1.right); + k1.h = ( + hlk1 > hrk1 ? hlk1 : hrk1 + ) + 1 | 0; + var hrk2 = Bs_internalAVLset.height(k2.right); + var hk1 = k1.h; + k2.h = ( + hrk2 > hk1 ? hrk2 : hk1 + ) + 1 | 0; + return k2; +} + +function doubleWithLeftChild(k3) { + var v = rotateWithLeftChild(k3.left); + k3.left = v; + return rotateWithLeftChild(k3); +} + +function doubleWithRightChild(k2) { + var v = rotateWithRightChild(k2.right); + k2.right = v; + return rotateWithRightChild(k2); +} + +function addMutate(t, x) { + if (t !== null) { + var k = t.key; + if (x === k) { + return t; + } else { + var l = t.left; + var r = t.right; + var t$1 = x < k ? (t.left = addMutate(l, x), Bs_internalAVLset.height(l) > (2 + Bs_internalAVLset.height(r) | 0) ? ( + x < l.key ? rotateWithLeftChild(t) : doubleWithLeftChild(t) + ) : t) : (t.right = addMutate(r, x), Bs_internalAVLset.height(r) > (2 + Bs_internalAVLset.height(l) | 0) ? ( + r.key < x ? rotateWithRightChild(t) : doubleWithRightChild(t) + ) : t); + var hlt = Bs_internalAVLset.height(t$1.left); + var hrt = Bs_internalAVLset.height(t$1.right); + t$1.h = ( + hlt > hrt ? hlt : hrt + ) + 1 | 0; + return t$1; + } + } else { + return { + left: null, + key: x, + right: null, + h: 1 + }; + } +} + +var N = 0; + +exports.N = N; +exports.add = add; +exports.splitAux = splitAux; +exports.split = split; +exports.mem = mem; +exports.remove = remove; +exports.union = union; +exports.inter = inter; +exports.diff = diff; +exports.compare_aux = compare_aux; +exports.cmp = cmp; +exports.eq_aux = eq_aux; +exports.eq = eq; +exports.subset = subset; +exports.findOpt = findOpt; +exports.findAssert = findAssert; +exports.ofArray = ofArray; +exports.rotateWithLeftChild = rotateWithLeftChild; +exports.rotateWithRightChild = rotateWithRightChild; +exports.doubleWithLeftChild = doubleWithLeftChild; +exports.doubleWithRightChild = doubleWithRightChild; +exports.addMutate = addMutate; +/* No side effect */ diff --git a/lib/js/bs_internalSetString.js b/lib/js/bs_internalSetString.js new file mode 100644 index 00000000000..870afdeb04f --- /dev/null +++ b/lib/js/bs_internalSetString.js @@ -0,0 +1,450 @@ +'use strict'; + +var Bs_internalAVLset = require("./bs_internalAVLset.js"); + +function add(x, t) { + if (t !== null) { + var v = t.key; + if (x === v) { + return t; + } else if (x < v) { + return Bs_internalAVLset.bal(add(x, t.left), v, t.right); + } else { + return Bs_internalAVLset.bal(t.left, v, add(x, t.right)); + } + } else { + return { + left: null, + key: x, + right: null, + h: 1 + }; + } +} + +function splitAux(x, n) { + var l = n.left; + var v = n.key; + var r = n.right; + if (x === v) { + return /* tuple */[ + l, + /* true */1, + r + ]; + } else if (x < v) { + if (l !== null) { + var match = splitAux(x, l); + return /* tuple */[ + match[0], + match[1], + Bs_internalAVLset.join(match[2], v, r) + ]; + } else { + return /* tuple */[ + null, + /* false */0, + n + ]; + } + } else if (r !== null) { + var match$1 = splitAux(x, r); + return /* tuple */[ + Bs_internalAVLset.join(l, v, match$1[0]), + match$1[1], + match$1[2] + ]; + } else { + return /* tuple */[ + n, + /* false */0, + null + ]; + } +} + +function split(x, t) { + if (t !== null) { + return splitAux(x, t); + } else { + return /* tuple */[ + null, + /* false */0, + null + ]; + } +} + +function mem(_t, x) { + while(true) { + var t = _t; + if (t !== null) { + var v = t.key; + if (x === v) { + return /* true */1; + } else { + _t = x < v ? t.left : t.right; + continue ; + + } + } else { + return /* false */0; + } + }; +} + +function remove(x, t) { + if (t !== null) { + var l = t.left; + var v = t.key; + var r = t.right; + if (x === v) { + return Bs_internalAVLset.merge(l, r); + } else if (x < v) { + return Bs_internalAVLset.bal(remove(x, l), v, r); + } else { + return Bs_internalAVLset.bal(l, v, remove(x, r)); + } + } else { + return t; + } +} + +function union(s1, s2) { + if (s1 !== null) { + if (s2 !== null) { + var h1 = s1.h; + var h2 = s2.h; + if (h1 >= h2) { + if (h2 === 1) { + return add(s2.key, s1); + } else { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var match = splitAux(v1, s2); + return Bs_internalAVLset.join(union(l1, match[0]), v1, union(r1, match[2])); + } + } else if (h1 === 1) { + return add(s1.key, s2); + } else { + var l2 = s2.left; + var v2 = s2.key; + var r2 = s2.right; + var match$1 = splitAux(v2, s1); + return Bs_internalAVLset.join(union(match$1[0], l2), v2, union(match$1[2], r2)); + } + } else { + return s1; + } + } else { + return s2; + } +} + +function inter(s1, s2) { + if (s1 !== null) { + if (s2 !== null) { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var match = splitAux(v1, s2); + var l2 = match[0]; + if (match[1] !== 0) { + return Bs_internalAVLset.join(inter(l1, l2), v1, inter(r1, match[2])); + } else { + return Bs_internalAVLset.concat(inter(l1, l2), inter(r1, match[2])); + } + } else { + return s2; + } + } else { + return s1; + } +} + +function diff(s1, s2) { + if (s1 !== null) { + if (s2 !== null) { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var match = splitAux(v1, s2); + var l2 = match[0]; + if (match[1] !== 0) { + return Bs_internalAVLset.concat(diff(l1, l2), diff(r1, match[2])); + } else { + return Bs_internalAVLset.join(diff(l1, l2), v1, diff(r1, match[2])); + } + } else { + return s1; + } + } else { + return s1; + } +} + +function compare_aux(_e1, _e2) { + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var v2 = e2[0]; + var v1 = e1[0]; + if (v1 !== v2) { + if (v1 < v2) { + return -1; + } else { + return 1; + } + } else { + _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); + _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); + continue ; + + } + } else { + return 1; + } + } else if (e2) { + return -1; + } else { + return 0; + } + }; +} + +function cmp(s1, s2) { + return compare_aux(Bs_internalAVLset.cons_enum(s1, /* End */0), Bs_internalAVLset.cons_enum(s2, /* End */0)); +} + +function eq_aux(_e1, _e2) { + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + if (e1[0] === e2[0]) { + _e2 = Bs_internalAVLset.cons_enum(e2[1], e2[2]); + _e1 = Bs_internalAVLset.cons_enum(e1[1], e1[2]); + continue ; + + } else { + return /* false */0; + } + } else { + return /* false */0; + } + } else if (e2) { + return /* false */0; + } else { + return /* true */1; + } + }; +} + +function eq(s1, s2) { + return eq_aux(Bs_internalAVLset.cons_enum(s1, /* End */0), Bs_internalAVLset.cons_enum(s2, /* End */0)); +} + +function subset(_s1, _s2) { + while(true) { + var s2 = _s2; + var s1 = _s1; + if (s1 !== null) { + if (s2 !== null) { + var l1 = s1.left; + var v1 = s1.key; + var r1 = s1.right; + var l2 = s2.left; + var v2 = s2.key; + var r2 = s2.right; + if (v1 === v2) { + if (subset(l1, l2)) { + _s2 = r2; + _s1 = r1; + continue ; + + } else { + return /* false */0; + } + } else if (v1 < v2) { + if (subset({ + left: l1, + key: v1, + right: null, + h: 0 + }, l2)) { + _s1 = r1; + continue ; + + } else { + return /* false */0; + } + } else if (subset({ + left: null, + key: v1, + right: r1, + h: 0 + }, r2)) { + _s1 = l1; + continue ; + + } else { + return /* false */0; + } + } else { + return /* false */0; + } + } else { + return /* true */1; + } + }; +} + +function findOpt(x, _n) { + while(true) { + var n = _n; + if (n !== null) { + var v = n.key; + if (x === v) { + return /* Some */[v]; + } else { + _n = x < v ? n.left : n.right; + continue ; + + } + } else { + return /* None */0; + } + }; +} + +function findAssert(x, _n) { + while(true) { + var n = _n; + if (n !== null) { + var v = n.key; + if (x === v) { + return /* Some */[v]; + } else { + _n = x < v ? n.left : n.right; + continue ; + + } + } else { + throw new Error("Not_found"); + } + }; +} + +function ofArray(xs) { + var result = null; + for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ + result = add(xs[i], result); + } + return result; +} + +function rotateWithLeftChild(k2) { + var k1 = k2.left; + k2.left = k1.right; + k1.right = k2; + var hlk2 = Bs_internalAVLset.height(k2.left); + var hrk2 = Bs_internalAVLset.height(k2.right); + k2.h = ( + hlk2 > hrk2 ? hlk2 : hrk2 + ) + 1 | 0; + var hlk1 = Bs_internalAVLset.height(k1.left); + var hk2 = k2.h; + k1.h = ( + hlk1 > hk2 ? hlk1 : hk2 + ) + 1 | 0; + return k1; +} + +function rotateWithRightChild(k1) { + var k2 = k1.right; + k1.right = k2.left; + k2.left = k1; + var hlk1 = Bs_internalAVLset.height(k1.left); + var hrk1 = Bs_internalAVLset.height(k1.right); + k1.h = ( + hlk1 > hrk1 ? hlk1 : hrk1 + ) + 1 | 0; + var hrk2 = Bs_internalAVLset.height(k2.right); + var hk1 = k1.h; + k2.h = ( + hrk2 > hk1 ? hrk2 : hk1 + ) + 1 | 0; + return k2; +} + +function doubleWithLeftChild(k3) { + var v = rotateWithLeftChild(k3.left); + k3.left = v; + return rotateWithLeftChild(k3); +} + +function doubleWithRightChild(k2) { + var v = rotateWithRightChild(k2.right); + k2.right = v; + return rotateWithRightChild(k2); +} + +function addMutate(t, x) { + if (t !== null) { + var k = t.key; + if (x === k) { + return t; + } else { + var l = t.left; + var r = t.right; + var t$1 = x < k ? (t.left = addMutate(l, x), Bs_internalAVLset.height(l) > (2 + Bs_internalAVLset.height(r) | 0) ? ( + x < l.key ? rotateWithLeftChild(t) : doubleWithLeftChild(t) + ) : t) : (t.right = addMutate(r, x), Bs_internalAVLset.height(r) > (2 + Bs_internalAVLset.height(l) | 0) ? ( + r.key < x ? rotateWithRightChild(t) : doubleWithRightChild(t) + ) : t); + var hlt = Bs_internalAVLset.height(t$1.left); + var hrt = Bs_internalAVLset.height(t$1.right); + t$1.h = ( + hlt > hrt ? hlt : hrt + ) + 1 | 0; + return t$1; + } + } else { + return { + left: null, + key: x, + right: null, + h: 1 + }; + } +} + +var N = 0; + +exports.N = N; +exports.add = add; +exports.splitAux = splitAux; +exports.split = split; +exports.mem = mem; +exports.remove = remove; +exports.union = union; +exports.inter = inter; +exports.diff = diff; +exports.compare_aux = compare_aux; +exports.cmp = cmp; +exports.eq_aux = eq_aux; +exports.eq = eq; +exports.subset = subset; +exports.findOpt = findOpt; +exports.findAssert = findAssert; +exports.ofArray = ofArray; +exports.rotateWithLeftChild = rotateWithLeftChild; +exports.rotateWithRightChild = rotateWithRightChild; +exports.doubleWithLeftChild = doubleWithLeftChild; +exports.doubleWithRightChild = doubleWithRightChild; +exports.addMutate = addMutate; +/* No side effect */ From d2ceed26387f683af6ba74d73806c9986e16a711 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Fri, 29 Dec 2017 14:29:55 +0800 Subject: [PATCH 2/3] fix a rotation thanks to coverage test --- jscomp/others/bs_SetInt.mli | 4 +-- jscomp/others/bs_SetIntM.ml | 4 ++- jscomp/others/bs_SetIntM.mli | 3 ++ jscomp/others/bs_SetString.mli | 4 +-- jscomp/others/bs_internalSetInt.ml | 52 ++++++++++++++++----------- jscomp/others/bs_internalSetString.ml | 52 ++++++++++++++++----------- jscomp/others/set.cppo.ml | 52 ++++++++++++++++----------- jscomp/others/set.cppo.mli | 4 +-- jscomp/test/.depend | 3 +- jscomp/test/bs_mutable_set_test.js | 26 +++++++++++++- jscomp/test/bs_mutable_set_test.ml | 17 +++++++-- jscomp/test/bs_set_bench.js | 6 ++-- jscomp/test/bs_set_bench.ml | 6 ++-- jscomp/test/bs_set_int_test.js | 26 +++++++------- jscomp/test/bs_set_int_test.ml | 24 ++++++------- lib/js/bs_SetIntM.js | 9 +++++ lib/js/bs_internalSetInt.js | 50 ++++++++++++++++---------- lib/js/bs_internalSetString.js | 50 ++++++++++++++++---------- 18 files changed, 246 insertions(+), 146 deletions(-) diff --git a/jscomp/others/bs_SetInt.mli b/jscomp/others/bs_SetInt.mli index 2cdd9d421f0..db89b7ff83a 100644 --- a/jscomp/others/bs_SetInt.mli +++ b/jscomp/others/bs_SetInt.mli @@ -16,14 +16,14 @@ val isEmpty: t -> bool val mem: t -> elt -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) -val add: elt -> t -> t +val add: t -> elt -> t (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) val singleton: elt -> t (** [singleton x] returns the one-element set containing only [x]. *) -val remove: elt -> t -> t +val remove: t -> elt -> t (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) diff --git a/jscomp/others/bs_SetIntM.ml b/jscomp/others/bs_SetIntM.ml index 49e8d2f0b2b..4368556a7cd 100644 --- a/jscomp/others/bs_SetIntM.ml +++ b/jscomp/others/bs_SetIntM.ml @@ -9,7 +9,8 @@ type elt = I.elt type t = I.t -let empty = N.empty0 +let empty = N.empty0 +(* No value restriction ? *) let isEmpty = N.isEmpty0 let singleton = N.singleton0 let min = N.min0 @@ -26,6 +27,7 @@ let toArray = N.toArray0 let checkInvariant = N.checkInvariant let add = I.addMutate +let addArray = I.addArrayMutate let ofArray = I.ofArray let cmp = I.cmp let diff = I.diff diff --git a/jscomp/others/bs_SetIntM.mli b/jscomp/others/bs_SetIntM.mli index 8c6ac46b485..774df47912c 100644 --- a/jscomp/others/bs_SetIntM.mli +++ b/jscomp/others/bs_SetIntM.mli @@ -12,6 +12,9 @@ val mem: t -> elt -> bool val add: t -> elt -> t +val addArray : t -> elt array -> t +val ofArray : elt array -> t +val toArray : t -> elt array val singleton: elt -> t (** [singleton x] returns the one-element set containing only [x]. *) diff --git a/jscomp/others/bs_SetString.mli b/jscomp/others/bs_SetString.mli index 58b44707a3c..b34103f303d 100644 --- a/jscomp/others/bs_SetString.mli +++ b/jscomp/others/bs_SetString.mli @@ -16,14 +16,14 @@ val isEmpty: t -> bool val mem: t -> elt -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) -val add: elt -> t -> t +val add: t -> elt -> t (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) val singleton: elt -> t (** [singleton x] returns the one-element set containing only [x]. *) -val remove: elt -> t -> t +val remove: t -> elt -> t (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) diff --git a/jscomp/others/bs_internalSetInt.ml b/jscomp/others/bs_internalSetInt.ml index 6f83490245d..8ddc498124f 100644 --- a/jscomp/others/bs_internalSetInt.ml +++ b/jscomp/others/bs_internalSetInt.ml @@ -4,7 +4,7 @@ type elt = int # 10 module N = Bs_internalAVLset - +module A = Bs_Array type ('elt, 'id) t0 = ('elt, 'id) N.t0 type ('elt, 'id) enumeration0 = @@ -17,14 +17,14 @@ type t = (elt, unit) t0 type enumeration = (elt,unit) enumeration0 -let rec add (x : elt) (t : t) : t = +let rec add (t : t) (x : elt) : t = match N.toOpt t with None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) | Some nt (* Node(l, v, r, _) as t *) -> let v = N.key nt in if x = v then t else - if x < v then N.(bal (add x (left nt)) v (right nt)) - else N.(bal (left nt) v (add x (right nt))) + if x < v then N.(bal (add (left nt) x) v (right nt)) + else N.(bal (left nt) v (add (right nt) x) ) @@ -66,14 +66,14 @@ let rec mem (t : t) (x : elt) = let v = N.key n in x = v || mem N.(if x < v then (left n) else (right n)) x -let rec remove (x : elt) (t : t) : t = +let rec remove (t : t) (x : elt) : t = match N.toOpt t with | None -> t | Some n (* Node(l, v, r, _) *) -> let l,v,r = N.(left n, key n, right n) in if x = v then N.merge l r else - if x < v then N.bal (remove x l) v r - else N.bal l v (remove x r) + if x < v then N.bal (remove l x) v r + else N.bal l v (remove r x) let rec union (s1 : t) (s2 : t) = match N.(toOpt s1, toOpt s2) with @@ -82,13 +82,13 @@ let rec union (s1 : t) (s2 : t) = | 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 add (N.key n2) s1 else begin + if h2 = 1 then add s1 (N.key n2) else begin let l1, v1, r1 = N.(left n1, key n1, right n1) in let (l2, _, r2) = splitAux v1 n2 in N.join (union l1 l2) v1 (union r1 r2) end else - if h1 = 1 then add (N.key n1) s2 else begin + 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) = splitAux v2 n1 in N.join (union l1 l2) v2 (union r1 r2) @@ -178,13 +178,6 @@ let rec findAssert (x : elt) (n :t) = else findAssert x N.(if x < v then (left t) else (right t)) -(* FIXME: use [sorted] attribute *) -let ofArray (xs : elt array) : t = - let result = ref N.empty in - for i = 0 to Array.length xs - 1 do - result := add (Bs_Array.unsafe_get xs i) !result - done ; - !result (* @@ -251,17 +244,17 @@ let rotateWithRightChild k1 = double l rotation *) let doubleWithLeftChild k3 = - let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in + let v = rotateWithRightChild (unsafeCoerce N.(left k3)) in N.(leftSet k3 (return v )); rotateWithLeftChild k3 let doubleWithRightChild k2 = - let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in + let v = rotateWithLeftChild (unsafeCoerce N.(right k2)) in N.(rightSet k2 (return v)); rotateWithRightChild k2 -type key = int -let rec addMutate (t : _ t0) (x : key)= + +let rec addMutate (t : _ t0) (x : elt)= match N.toOpt t with | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) | Some nt -> @@ -298,4 +291,21 @@ let rec addMutate (t : _ t0) (x : key)= N.hSet t N.(Pervasives.max hlt hrt + 1); N.return t - end \ No newline at end of file + end + + +let addArrayMutate (t : _ t0) xs = + let v = ref t in + for i = 0 to A.length xs - 1 do + v := addMutate !v (A.unsafe_get xs i) + done ; + !v + +(* FIXME: improve, use [sorted] attribute *) +let ofArray (xs : elt array) : t = + let result = ref N.empty in + for i = 0 to A.length xs - 1 do + result := addMutate !result (A.unsafe_get xs i) + done ; + !result + \ No newline at end of file diff --git a/jscomp/others/bs_internalSetString.ml b/jscomp/others/bs_internalSetString.ml index a574a82988e..e2bb91efb13 100644 --- a/jscomp/others/bs_internalSetString.ml +++ b/jscomp/others/bs_internalSetString.ml @@ -4,7 +4,7 @@ type elt = string # 10 module N = Bs_internalAVLset - +module A = Bs_Array type ('elt, 'id) t0 = ('elt, 'id) N.t0 type ('elt, 'id) enumeration0 = @@ -17,14 +17,14 @@ type t = (elt, unit) t0 type enumeration = (elt,unit) enumeration0 -let rec add (x : elt) (t : t) : t = +let rec add (t : t) (x : elt) : t = match N.toOpt t with None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) | Some nt (* Node(l, v, r, _) as t *) -> let v = N.key nt in if x = v then t else - if x < v then N.(bal (add x (left nt)) v (right nt)) - else N.(bal (left nt) v (add x (right nt))) + if x < v then N.(bal (add (left nt) x) v (right nt)) + else N.(bal (left nt) v (add (right nt) x) ) @@ -66,14 +66,14 @@ let rec mem (t : t) (x : elt) = let v = N.key n in x = v || mem N.(if x < v then (left n) else (right n)) x -let rec remove (x : elt) (t : t) : t = +let rec remove (t : t) (x : elt) : t = match N.toOpt t with | None -> t | Some n (* Node(l, v, r, _) *) -> let l,v,r = N.(left n, key n, right n) in if x = v then N.merge l r else - if x < v then N.bal (remove x l) v r - else N.bal l v (remove x r) + if x < v then N.bal (remove l x) v r + else N.bal l v (remove r x) let rec union (s1 : t) (s2 : t) = match N.(toOpt s1, toOpt s2) with @@ -82,13 +82,13 @@ let rec union (s1 : t) (s2 : t) = | 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 add (N.key n2) s1 else begin + if h2 = 1 then add s1 (N.key n2) else begin let l1, v1, r1 = N.(left n1, key n1, right n1) in let (l2, _, r2) = splitAux v1 n2 in N.join (union l1 l2) v1 (union r1 r2) end else - if h1 = 1 then add (N.key n1) s2 else begin + 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) = splitAux v2 n1 in N.join (union l1 l2) v2 (union r1 r2) @@ -178,13 +178,6 @@ let rec findAssert (x : elt) (n :t) = else findAssert x N.(if x < v then (left t) else (right t)) -(* FIXME: use [sorted] attribute *) -let ofArray (xs : elt array) : t = - let result = ref N.empty in - for i = 0 to Array.length xs - 1 do - result := add (Bs_Array.unsafe_get xs i) !result - done ; - !result (* @@ -251,17 +244,17 @@ let rotateWithRightChild k1 = double l rotation *) let doubleWithLeftChild k3 = - let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in + let v = rotateWithRightChild (unsafeCoerce N.(left k3)) in N.(leftSet k3 (return v )); rotateWithLeftChild k3 let doubleWithRightChild k2 = - let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in + let v = rotateWithLeftChild (unsafeCoerce N.(right k2)) in N.(rightSet k2 (return v)); rotateWithRightChild k2 -type key = int -let rec addMutate (t : _ t0) (x : key)= + +let rec addMutate (t : _ t0) (x : elt)= match N.toOpt t with | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) | Some nt -> @@ -298,4 +291,21 @@ let rec addMutate (t : _ t0) (x : key)= N.hSet t N.(Pervasives.max hlt hrt + 1); N.return t - end \ No newline at end of file + end + + +let addArrayMutate (t : _ t0) xs = + let v = ref t in + for i = 0 to A.length xs - 1 do + v := addMutate !v (A.unsafe_get xs i) + done ; + !v + +(* FIXME: improve, use [sorted] attribute *) +let ofArray (xs : elt array) : t = + let result = ref N.empty in + for i = 0 to A.length xs - 1 do + result := addMutate !result (A.unsafe_get xs i) + done ; + !result + \ No newline at end of file diff --git a/jscomp/others/set.cppo.ml b/jscomp/others/set.cppo.ml index 4a1177e68ed..a1e361ef3bb 100644 --- a/jscomp/others/set.cppo.ml +++ b/jscomp/others/set.cppo.ml @@ -8,7 +8,7 @@ type elt = int module N = Bs_internalAVLset - +module A = Bs_Array type ('elt, 'id) t0 = ('elt, 'id) N.t0 type ('elt, 'id) enumeration0 = @@ -21,14 +21,14 @@ type t = (elt, unit) t0 type enumeration = (elt,unit) enumeration0 -let rec add (x : elt) (t : t) : t = +let rec add (t : t) (x : elt) : t = match N.toOpt t with None -> N.(return @@ node ~left:empty ~key:x ~right:empty ~h:1) | Some nt (* Node(l, v, r, _) as t *) -> let v = N.key nt in if x = v then t else - if x < v then N.(bal (add x (left nt)) v (right nt)) - else N.(bal (left nt) v (add x (right nt))) + if x < v then N.(bal (add (left nt) x) v (right nt)) + else N.(bal (left nt) v (add (right nt) x) ) @@ -70,14 +70,14 @@ let rec mem (t : t) (x : elt) = let v = N.key n in x = v || mem N.(if x < v then (left n) else (right n)) x -let rec remove (x : elt) (t : t) : t = +let rec remove (t : t) (x : elt) : t = match N.toOpt t with | None -> t | Some n (* Node(l, v, r, _) *) -> let l,v,r = N.(left n, key n, right n) in if x = v then N.merge l r else - if x < v then N.bal (remove x l) v r - else N.bal l v (remove x r) + if x < v then N.bal (remove l x) v r + else N.bal l v (remove r x) let rec union (s1 : t) (s2 : t) = match N.(toOpt s1, toOpt s2) with @@ -86,13 +86,13 @@ let rec union (s1 : t) (s2 : t) = | 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 add (N.key n2) s1 else begin + if h2 = 1 then add s1 (N.key n2) else begin let l1, v1, r1 = N.(left n1, key n1, right n1) in let (l2, _, r2) = splitAux v1 n2 in N.join (union l1 l2) v1 (union r1 r2) end else - if h1 = 1 then add (N.key n1) s2 else begin + 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) = splitAux v2 n1 in N.join (union l1 l2) v2 (union r1 r2) @@ -182,13 +182,6 @@ let rec findAssert (x : elt) (n :t) = else findAssert x N.(if x < v then (left t) else (right t)) -(* FIXME: use [sorted] attribute *) -let ofArray (xs : elt array) : t = - let result = ref N.empty in - for i = 0 to Array.length xs - 1 do - result := add (Bs_Array.unsafe_get xs i) !result - done ; - !result (* @@ -255,17 +248,17 @@ let rotateWithRightChild k1 = double l rotation *) let doubleWithLeftChild k3 = - let v = rotateWithLeftChild (unsafeCoerce N.(left k3)) in + let v = rotateWithRightChild (unsafeCoerce N.(left k3)) in N.(leftSet k3 (return v )); rotateWithLeftChild k3 let doubleWithRightChild k2 = - let v = rotateWithRightChild (unsafeCoerce N.(right k2)) in + let v = rotateWithLeftChild (unsafeCoerce N.(right k2)) in N.(rightSet k2 (return v)); rotateWithRightChild k2 -type key = int -let rec addMutate (t : _ t0) (x : key)= + +let rec addMutate (t : _ t0) (x : elt)= match N.toOpt t with | None -> N.(return @@ node ~left:empty ~right:empty ~key:x ~h:1) | Some nt -> @@ -302,4 +295,21 @@ let rec addMutate (t : _ t0) (x : key)= N.hSet t N.(Pervasives.max hlt hrt + 1); N.return t - end \ No newline at end of file + end + + +let addArrayMutate (t : _ t0) xs = + let v = ref t in + for i = 0 to A.length xs - 1 do + v := addMutate !v (A.unsafe_get xs i) + done ; + !v + +(* FIXME: improve, use [sorted] attribute *) +let ofArray (xs : elt array) : t = + let result = ref N.empty in + for i = 0 to A.length xs - 1 do + result := addMutate !result (A.unsafe_get xs i) + done ; + !result + \ No newline at end of file diff --git a/jscomp/others/set.cppo.mli b/jscomp/others/set.cppo.mli index 7c73ee6d895..b41585cf661 100644 --- a/jscomp/others/set.cppo.mli +++ b/jscomp/others/set.cppo.mli @@ -20,14 +20,14 @@ val isEmpty: t -> bool val mem: t -> elt -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) -val add: elt -> t -> t +val add: t -> elt -> t (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) val singleton: elt -> t (** [singleton x] returns the one-element set containing only [x]. *) -val remove: elt -> t -> t +val remove: t -> elt -> t (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) diff --git a/jscomp/test/.depend b/jscomp/test/.depend index c6293b958ed..35ca83754b0 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -100,8 +100,7 @@ bs_list_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj bs_map_int_test.cmj : mt.cmj ../others/bs.cmj bs_map_test.cmj : ../runtime/js.cmj ../others/bs.cmj bs_min_max_test.cmj : ../stdlib/pervasives.cmj mt.cmj -bs_mutable_set_test.cmj : mt.cmj ../runtime/js.cmj ../others/bs.cmj \ - array_data_util.cmj +bs_mutable_set_test.cmj : mt.cmj ../others/bs.cmj array_data_util.cmj bs_node_string_buffer_test.cmj : ../others/node.cmj ../runtime/js.cmj bs_qualified.cmj : ../runtime/js.cmj bs_queue_test.cmj : ../runtime/js.cmj ../others/bs.cmj diff --git a/jscomp/test/bs_mutable_set_test.js b/jscomp/test/bs_mutable_set_test.js index af856c1aa6b..e36cc5e7615 100644 --- a/jscomp/test/bs_mutable_set_test.js +++ b/jscomp/test/bs_mutable_set_test.js @@ -1,8 +1,10 @@ 'use strict'; var Mt = require("./mt.js"); +var Bs_Array = require("../../lib/js/bs_Array.js"); var Bs_Range = require("../../lib/js/bs_Range.js"); var Bs_SetIntM = require("../../lib/js/bs_SetIntM.js"); +var Array_data_util = require("./array_data_util.js"); var suites = [/* [] */0]; @@ -28,7 +30,23 @@ b("File \"bs_mutable_set_test.ml\", line 20, characters 4-11", Bs_Range.forAll(0 return Bs_SetIntM.mem(v[0], i); }))); -console.log(Bs_SetIntM.length(v[0])); +eq("File \"bs_mutable_set_test.ml\", line 23, characters 5-12", Bs_SetIntM.length(v[0]), 100001); + +var u = Bs_Array.append(Array_data_util.randomRange(30, 100), Array_data_util.randomRange(40, 120)); + +var v$1 = Bs_SetIntM.empty; + +var v$2 = Bs_SetIntM.addArray(v$1, u); + +eq("File \"bs_mutable_set_test.ml\", line 29, characters 5-12", Bs_SetIntM.length(v$2), 91); + +eq("File \"bs_mutable_set_test.ml\", line 30, characters 5-12", Bs_SetIntM.toArray(v$2), Array_data_util.range(30, 120)); + +var u$1 = Bs_Array.append(Array_data_util.randomRange(0, 100000), Array_data_util.randomRange(0, 100)); + +var v$3 = Bs_SetIntM.ofArray(u$1); + +eq("File \"bs_mutable_set_test.ml\", line 35, characters 5-12", Bs_SetIntM.length(v$3), 100001); Mt.from_pair_suites("bs_mutable_set_test.ml", suites[0]); @@ -38,6 +56,10 @@ var I = 0; var R = 0; +var A = 0; + +var $plus$plus = Bs_Array.append; + exports.suites = suites; exports.test_id = test_id; exports.eq = eq; @@ -45,4 +67,6 @@ exports.b = b; exports.N = N; exports.I = I; exports.R = R; +exports.A = A; +exports.$plus$plus = $plus$plus; /* Not a pure module */ diff --git a/jscomp/test/bs_mutable_set_test.ml b/jscomp/test/bs_mutable_set_test.ml index 4c7ebd4f74c..2e05214f197 100644 --- a/jscomp/test/bs_mutable_set_test.ml +++ b/jscomp/test/bs_mutable_set_test.ml @@ -7,8 +7,8 @@ module N = Bs.SetIntM module I = Array_data_util module R = Bs.Range - - +module A = Bs.Array +let (++)= A.append let () = let v = ref N.empty in @@ -20,7 +20,18 @@ let () = b __LOC__ @@ R.forAll 0 1_00_000 (fun [@bs] i -> N.mem !v i ); - Js.log (N.length !v) + eq __LOC__ (N.length !v) 1_00_001 +let () = + let u = I.randomRange 30 100 ++ I.randomRange 40 120 in + let v = ref N.empty in + let v = N.addArray !v u in + eq __LOC__ (N.length v) 91 ; + eq __LOC__ (N.toArray v) (I.range 30 120) +let () = + let u = I.randomRange 0 100_000 ++ I.randomRange 0 100 in + let v = N.ofArray u in + eq __LOC__ (N.length v) 100_001 + ;; Mt.from_pair_suites __FILE__ !suites \ No newline at end of file diff --git a/jscomp/test/bs_set_bench.js b/jscomp/test/bs_set_bench.js index 3e30ccb4944..7b8d768d49e 100644 --- a/jscomp/test/bs_set_bench.js +++ b/jscomp/test/bs_set_bench.js @@ -7,12 +7,12 @@ function bench() { var data = Bs_SetInt.empty; console.time("bs_set_bench.ml 7"); for(var i = 0; i <= 1000000; ++i){ - data = Bs_SetInt.add(i, data); + data = Bs_SetInt.add(data, i); } console.timeEnd("bs_set_bench.ml 7"); console.time("bs_set_bench.ml 11"); for(var i$1 = 0; i$1 <= 1000000; ++i$1){ - if (!Bs_SetInt.mem(i$1, data)) { + if (!Bs_SetInt.mem(data, i$1)) { throw [ Caml_builtin_exceptions.assert_failure, [ @@ -27,7 +27,7 @@ function bench() { console.timeEnd("bs_set_bench.ml 11"); console.time("bs_set_bench.ml 14"); for(var i$2 = 0; i$2 <= 1000000; ++i$2){ - data = Bs_SetInt.remove(i$2, data); + data = Bs_SetInt.remove(data, i$2); } console.timeEnd("bs_set_bench.ml 14"); if (Bs_SetInt.length(data)) { diff --git a/jscomp/test/bs_set_bench.ml b/jscomp/test/bs_set_bench.ml index 7f29aa771cc..abc52731b8c 100644 --- a/jscomp/test/bs_set_bench.ml +++ b/jscomp/test/bs_set_bench.ml @@ -6,13 +6,13 @@ let bench () = let data = ref Bs.SetInt.empty in [%time for i = 0 to count do data := - Bs.SetInt.add i !data + Bs.SetInt.add !data i done] ; [%time for i = 0 to count do - assert (Bs.SetInt.mem i !data) + assert (Bs.SetInt.mem !data i) done]; [%time for i = 0 to count do - data := Bs.SetInt.remove i !data + data := Bs.SetInt.remove !data i done ]; assert (Bs.SetInt.length !data = 0) diff --git a/jscomp/test/bs_set_int_test.js b/jscomp/test/bs_set_int_test.js index 4a9bc15cf1a..db1e49fe997 100644 --- a/jscomp/test/bs_set_int_test.js +++ b/jscomp/test/bs_set_int_test.js @@ -100,9 +100,9 @@ var r = Bs_SetInt.empty; for(var i$1 = 100; i$1 <= 1500; ++i$1){ if (i$1 % 3) { - r = Bs_SetInt.add(i$1, r); + r = Bs_SetInt.add(r, i$1); } else { - l = Bs_SetInt.add(i$1, l); + l = Bs_SetInt.add(l, i$1); } } @@ -182,7 +182,7 @@ eq("File \"bs_set_int_test.ml\", line 80, characters 5-12", minv, /* Some */[-1] eq("File \"bs_set_int_test.ml\", line 81, characters 5-12", maxv, /* Some */[222]); -var v$2 = Bs_SetInt.remove(3, v$1); +var v$2 = Bs_SetInt.remove(v$1, 3); var minv$1 = Bs_SetInt.min(v$2); @@ -192,7 +192,7 @@ eq("File \"bs_set_int_test.ml\", line 84, characters 5-12", minv$1, /* Some */[- eq("File \"bs_set_int_test.ml\", line 85, characters 5-12", maxv$1, /* Some */[222]); -var v$3 = Bs_SetInt.remove(222, v$2); +var v$3 = Bs_SetInt.remove(v$2, 222); var minv$2 = Bs_SetInt.min(v$3); @@ -202,7 +202,7 @@ eq("File \"bs_set_int_test.ml\", line 88, characters 5-12", minv$2, /* Some */[- eq("File \"bs_set_int_test.ml\", line 89, characters 5-12", maxv$2, /* Some */[33]); -var v$4 = Bs_SetInt.remove(-1, v$3); +var v$4 = Bs_SetInt.remove(v$3, -1); var minv$3 = Bs_SetInt.min(v$4); @@ -212,17 +212,17 @@ eq("File \"bs_set_int_test.ml\", line 92, characters 5-12", minv$3, /* Some */[0 eq("File \"bs_set_int_test.ml\", line 93, characters 5-12", maxv$3, /* Some */[33]); -var v$5 = Bs_SetInt.remove(0, v$4); +var v$5 = Bs_SetInt.remove(v$4, 0); -var v$6 = Bs_SetInt.remove(33, v$5); +var v$6 = Bs_SetInt.remove(v$5, 33); -var v$7 = Bs_SetInt.remove(2, v$6); +var v$7 = Bs_SetInt.remove(v$6, 2); -var v$8 = Bs_SetInt.remove(3, v$7); +var v$8 = Bs_SetInt.remove(v$7, 3); -var v$9 = Bs_SetInt.remove(4, v$8); +var v$9 = Bs_SetInt.remove(v$8, 4); -var v$10 = Bs_SetInt.remove(1, v$9); +var v$10 = Bs_SetInt.remove(v$9, 1); b("File \"bs_set_int_test.ml\", line 100, characters 4-11", Bs_SetInt.isEmpty(v$10)); @@ -238,9 +238,7 @@ b("File \"bs_set_int_test.ml\", line 108, characters 4-11", Bs_SetInt.checkInvar var firstHalf = Bs_Array.sub(v$11, 0, 2000); -var xx = Bs_Array.foldLeft(firstHalf, u$1, (function (acc, x) { - return Bs_SetInt.remove(x, acc); - })); +var xx = Bs_Array.foldLeft(firstHalf, u$1, Bs_SetInt.remove); b("File \"bs_set_int_test.ml\", line 112, characters 4-11", Bs_SetInt.checkInvariant(u$1)); diff --git a/jscomp/test/bs_set_int_test.ml b/jscomp/test/bs_set_int_test.ml index efa2367db2d..2897789a42d 100644 --- a/jscomp/test/bs_set_int_test.ml +++ b/jscomp/test/bs_set_int_test.ml @@ -46,9 +46,9 @@ let () = let l,r = ref N.empty, ref N.empty in for i = 100 to 1500 do if i mod 3 = 0 then - l := N.add i !l + l := N.add !l i else - r := N.add i !r + r := N.add !r i done; !l, !r in b __LOC__ (N.eq l nl); @@ -79,24 +79,24 @@ let () = eq __LOC__ (N.fold (fun [@bs] x y -> x + y) v 0) (Array.fold_left (+) 0 ss) ; eq __LOC__ minv (Some (-1)); eq __LOC__ maxv (Some 222); - let v = N.remove 3 v in + let v = N.remove v 3 in let minv, maxv = N.min v, N.max v in eq __LOC__ minv (Some (-1)); eq __LOC__ maxv (Some 222); - let v = N.remove 222 v in + let v = N.remove v 222 in let minv, maxv = N.min v, N.max v in eq __LOC__ minv (Some (-1)); eq __LOC__ maxv (Some 33); - let v = N.remove (-1) v in + let v = N.remove v (-1) in let minv, maxv = N.min v, N.max v in eq __LOC__ minv (Some (0)); eq __LOC__ maxv (Some 33); - let v = N.remove 0 v in - let v = N.remove 33 v in - let v = N.remove 2 v in - let v = N.remove 3 v in - let v = N.remove 4 v in - let v = N.remove 1 v in + let v = N.remove v 0 in + let v = N.remove v 33 in + let v = N.remove v 2 in + let v = N.remove v 3 in + let v = N.remove v 4 in + let v = N.remove v 1 in b __LOC__ (N.isEmpty v ) @@ -108,7 +108,7 @@ let () = b __LOC__ (N.checkInvariant u ); let firstHalf = Bs.Array.sub v 0 2_000 in let xx = Bs.Array.foldLeft firstHalf u - (fun[@bs] acc x -> N.remove x acc) in + (fun[@bs] acc x -> N.remove acc x ) in b __LOC__ (N.checkInvariant u); b __LOC__ N.(eq (union (ofArray firstHalf) xx) u) diff --git a/lib/js/bs_SetIntM.js b/lib/js/bs_SetIntM.js index d1ab0a5e7a4..c2bb3c3a02b 100644 --- a/lib/js/bs_SetIntM.js +++ b/lib/js/bs_SetIntM.js @@ -11,6 +11,12 @@ var mem = Bs_internalSetInt.mem; var add = Bs_internalSetInt.addMutate; +var addArray = Bs_internalSetInt.addArrayMutate; + +var ofArray = Bs_internalSetInt.ofArray; + +var toArray = Bs_internalAVLset.toArray0; + var singleton = Bs_internalAVLset.singleton0; var checkInvariant = Bs_internalAVLset.checkInvariant; @@ -21,6 +27,9 @@ exports.empty = empty; exports.isEmpty = isEmpty; exports.mem = mem; exports.add = add; +exports.addArray = addArray; +exports.ofArray = ofArray; +exports.toArray = toArray; exports.singleton = singleton; exports.checkInvariant = checkInvariant; exports.length = length; diff --git a/lib/js/bs_internalSetInt.js b/lib/js/bs_internalSetInt.js index 870afdeb04f..5acbbc13c37 100644 --- a/lib/js/bs_internalSetInt.js +++ b/lib/js/bs_internalSetInt.js @@ -2,15 +2,15 @@ var Bs_internalAVLset = require("./bs_internalAVLset.js"); -function add(x, t) { +function add(t, x) { if (t !== null) { var v = t.key; if (x === v) { return t; } else if (x < v) { - return Bs_internalAVLset.bal(add(x, t.left), v, t.right); + return Bs_internalAVLset.bal(add(t.left, x), v, t.right); } else { - return Bs_internalAVLset.bal(t.left, v, add(x, t.right)); + return Bs_internalAVLset.bal(t.left, v, add(t.right, x)); } } else { return { @@ -93,7 +93,7 @@ function mem(_t, x) { }; } -function remove(x, t) { +function remove(t, x) { if (t !== null) { var l = t.left; var v = t.key; @@ -101,9 +101,9 @@ function remove(x, t) { if (x === v) { return Bs_internalAVLset.merge(l, r); } else if (x < v) { - return Bs_internalAVLset.bal(remove(x, l), v, r); + return Bs_internalAVLset.bal(remove(l, x), v, r); } else { - return Bs_internalAVLset.bal(l, v, remove(x, r)); + return Bs_internalAVLset.bal(l, v, remove(r, x)); } } else { return t; @@ -117,7 +117,7 @@ function union(s1, s2) { var h2 = s2.h; if (h1 >= h2) { if (h2 === 1) { - return add(s2.key, s1); + return add(s1, s2.key); } else { var l1 = s1.left; var v1 = s1.key; @@ -126,7 +126,7 @@ function union(s1, s2) { return Bs_internalAVLset.join(union(l1, match[0]), v1, union(r1, match[2])); } } else if (h1 === 1) { - return add(s1.key, s2); + return add(s2, s1.key); } else { var l2 = s2.left; var v2 = s2.key; @@ -339,14 +339,6 @@ function findAssert(x, _n) { }; } -function ofArray(xs) { - var result = null; - for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ - result = add(xs[i], result); - } - return result; -} - function rotateWithLeftChild(k2) { var k1 = k2.left; k2.left = k1.right; @@ -382,13 +374,13 @@ function rotateWithRightChild(k1) { } function doubleWithLeftChild(k3) { - var v = rotateWithLeftChild(k3.left); + var v = rotateWithRightChild(k3.left); k3.left = v; return rotateWithLeftChild(k3); } function doubleWithRightChild(k2) { - var v = rotateWithRightChild(k2.right); + var v = rotateWithLeftChild(k2.right); k2.right = v; return rotateWithRightChild(k2); } @@ -423,9 +415,28 @@ function addMutate(t, x) { } } +function addArrayMutate(t, xs) { + var v = t; + for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ + v = addMutate(v, xs[i]); + } + return v; +} + +function ofArray(xs) { + var result = null; + for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ + result = addMutate(result, xs[i]); + } + return result; +} + var N = 0; +var A = 0; + exports.N = N; +exports.A = A; exports.add = add; exports.splitAux = splitAux; exports.split = split; @@ -441,10 +452,11 @@ exports.eq = eq; exports.subset = subset; exports.findOpt = findOpt; exports.findAssert = findAssert; -exports.ofArray = ofArray; exports.rotateWithLeftChild = rotateWithLeftChild; exports.rotateWithRightChild = rotateWithRightChild; exports.doubleWithLeftChild = doubleWithLeftChild; exports.doubleWithRightChild = doubleWithRightChild; exports.addMutate = addMutate; +exports.addArrayMutate = addArrayMutate; +exports.ofArray = ofArray; /* No side effect */ diff --git a/lib/js/bs_internalSetString.js b/lib/js/bs_internalSetString.js index 870afdeb04f..5acbbc13c37 100644 --- a/lib/js/bs_internalSetString.js +++ b/lib/js/bs_internalSetString.js @@ -2,15 +2,15 @@ var Bs_internalAVLset = require("./bs_internalAVLset.js"); -function add(x, t) { +function add(t, x) { if (t !== null) { var v = t.key; if (x === v) { return t; } else if (x < v) { - return Bs_internalAVLset.bal(add(x, t.left), v, t.right); + return Bs_internalAVLset.bal(add(t.left, x), v, t.right); } else { - return Bs_internalAVLset.bal(t.left, v, add(x, t.right)); + return Bs_internalAVLset.bal(t.left, v, add(t.right, x)); } } else { return { @@ -93,7 +93,7 @@ function mem(_t, x) { }; } -function remove(x, t) { +function remove(t, x) { if (t !== null) { var l = t.left; var v = t.key; @@ -101,9 +101,9 @@ function remove(x, t) { if (x === v) { return Bs_internalAVLset.merge(l, r); } else if (x < v) { - return Bs_internalAVLset.bal(remove(x, l), v, r); + return Bs_internalAVLset.bal(remove(l, x), v, r); } else { - return Bs_internalAVLset.bal(l, v, remove(x, r)); + return Bs_internalAVLset.bal(l, v, remove(r, x)); } } else { return t; @@ -117,7 +117,7 @@ function union(s1, s2) { var h2 = s2.h; if (h1 >= h2) { if (h2 === 1) { - return add(s2.key, s1); + return add(s1, s2.key); } else { var l1 = s1.left; var v1 = s1.key; @@ -126,7 +126,7 @@ function union(s1, s2) { return Bs_internalAVLset.join(union(l1, match[0]), v1, union(r1, match[2])); } } else if (h1 === 1) { - return add(s1.key, s2); + return add(s2, s1.key); } else { var l2 = s2.left; var v2 = s2.key; @@ -339,14 +339,6 @@ function findAssert(x, _n) { }; } -function ofArray(xs) { - var result = null; - for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ - result = add(xs[i], result); - } - return result; -} - function rotateWithLeftChild(k2) { var k1 = k2.left; k2.left = k1.right; @@ -382,13 +374,13 @@ function rotateWithRightChild(k1) { } function doubleWithLeftChild(k3) { - var v = rotateWithLeftChild(k3.left); + var v = rotateWithRightChild(k3.left); k3.left = v; return rotateWithLeftChild(k3); } function doubleWithRightChild(k2) { - var v = rotateWithRightChild(k2.right); + var v = rotateWithLeftChild(k2.right); k2.right = v; return rotateWithRightChild(k2); } @@ -423,9 +415,28 @@ function addMutate(t, x) { } } +function addArrayMutate(t, xs) { + var v = t; + for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ + v = addMutate(v, xs[i]); + } + return v; +} + +function ofArray(xs) { + var result = null; + for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ + result = addMutate(result, xs[i]); + } + return result; +} + var N = 0; +var A = 0; + exports.N = N; +exports.A = A; exports.add = add; exports.splitAux = splitAux; exports.split = split; @@ -441,10 +452,11 @@ exports.eq = eq; exports.subset = subset; exports.findOpt = findOpt; exports.findAssert = findAssert; -exports.ofArray = ofArray; exports.rotateWithLeftChild = rotateWithLeftChild; exports.rotateWithRightChild = rotateWithRightChild; exports.doubleWithLeftChild = doubleWithLeftChild; exports.doubleWithRightChild = doubleWithRightChild; exports.addMutate = addMutate; +exports.addArrayMutate = addArrayMutate; +exports.ofArray = ofArray; /* No side effect */ From 5f348dc697afe39efd56c55338097d1ca4ae7bd9 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sat, 30 Dec 2017 11:25:36 +0800 Subject: [PATCH 3/3] wip: get mutation remove works --- jscomp/others/.depend | 2 + jscomp/others/Makefile | 1 + jscomp/others/bs_SetIntM.ml | 3 +- jscomp/others/bs_SetIntM.mli | 2 +- jscomp/others/bs_internalSetInt.ml | 105 ++++++++++++++++------- jscomp/others/bs_internalSetString.ml | 110 ++++++++++++++++-------- jscomp/others/set.cppo.ml | 118 +++++++++++++++++--------- jscomp/test/bs_mutable_set_test.js | 12 +++ jscomp/test/bs_mutable_set_test.ml | 11 ++- lib/js/bs_SetIntM.js | 3 + lib/js/bs_internalSetInt.js | 104 ++++++++++++++++++++--- lib/js/bs_internalSetString.js | 99 ++++++++++++++++++--- 12 files changed, 437 insertions(+), 133 deletions(-) diff --git a/jscomp/others/.depend b/jscomp/others/.depend index 69d8718629c..67ec305ae88 100644 --- a/jscomp/others/.depend +++ b/jscomp/others/.depend @@ -49,6 +49,7 @@ bs_MapInt.cmj : bs_internalAVLtree.cmj bs_Array.cmj bs_MapInt.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_SetString.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \ bs_SetString.cmi node_child_process.cmj : node.cmj @@ -90,6 +91,7 @@ bs_Set.cmi : bs_Cmp.cmi bs_Bag.cmj bs_MapString.cmi : bs_MapInt.cmi : bs_SetInt.cmi : +bs_SetIntM.cmi : bs_SetString.cmi : js_boolean.cmi : js_dict.cmi : diff --git a/jscomp/others/Makefile b/jscomp/others/Makefile index 7d7f3c1ae42..ba6b3e643f1 100644 --- a/jscomp/others/Makefile +++ b/jscomp/others/Makefile @@ -36,6 +36,7 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string bs_internalSetInt\ bs_internalSetString\ bs_SetInt\ + bs_SetIntM\ bs_SetString\ node_child_process js_boolean js_math\ js_dict js_date js_global js_cast js_promise\ diff --git a/jscomp/others/bs_SetIntM.ml b/jscomp/others/bs_SetIntM.ml index 4368556a7cd..33ea06d1faf 100644 --- a/jscomp/others/bs_SetIntM.ml +++ b/jscomp/others/bs_SetIntM.ml @@ -28,6 +28,8 @@ let checkInvariant = N.checkInvariant let add = I.addMutate let addArray = I.addArrayMutate + +let remove = I.removeMutate let ofArray = I.ofArray let cmp = I.cmp let diff = I.diff @@ -37,5 +39,4 @@ let split = I.split let subset = I.subset let inter = I.inter let union = I.union -let remove = I.remove let mem = I.mem diff --git a/jscomp/others/bs_SetIntM.mli b/jscomp/others/bs_SetIntM.mli index 774df47912c..8b58d6a47f9 100644 --- a/jscomp/others/bs_SetIntM.mli +++ b/jscomp/others/bs_SetIntM.mli @@ -11,7 +11,7 @@ val mem: t -> elt -> bool val add: t -> elt -> t - +val remove : t -> elt -> t val addArray : t -> elt array -> t val ofArray : elt array -> t val toArray : t -> elt array diff --git a/jscomp/others/bs_internalSetInt.ml b/jscomp/others/bs_internalSetInt.ml index 8ddc498124f..fdebb8e1666 100644 --- a/jscomp/others/bs_internalSetInt.ml +++ b/jscomp/others/bs_internalSetInt.ml @@ -253,6 +253,37 @@ let doubleWithRightChild k2 = N.(rightSet k2 (return v)); rotateWithRightChild k2 +let heightUpdateMutate t = + let hlt, hrt = N.(height (left t),(height (right t))) in + N.hSet t (Pervasives.max hlt hrt + 1); + t + +let balMutate nt = + let l, r = N.(left nt, right nt) in + let hl, hr = N.(height l, height r) in + if hl > 2 + hr then + let l = unsafeCoerce l in + let ll, lr = N.(left l , right l)in + (if N.height ll >= N.height lr then + heightUpdateMutate (rotateWithLeftChild nt) + else + heightUpdateMutate (doubleWithLeftChild nt) + ) + else + if hr > 2 + hl then + let r = unsafeCoerce r in + let rl,rr = N.(left r, right r) in + (if N.height rr >= N.height rl then + heightUpdateMutate (rotateWithRightChild nt) + else + heightUpdateMutate (doubleWithRightChild nt) + ) + else + begin + N.hSet nt (max hl hr + 1); + nt + end + (* heightUpdateMutate nt *) let rec addMutate (t : _ t0) (x : elt)= match N.toOpt t with @@ -261,37 +292,50 @@ let rec addMutate (t : _ t0) (x : elt)= let k = N.key nt in if x = k then t else - begin - let l, r = N.(left nt, right nt) in - let t = - (if x < k then - begin - N.leftSet nt (addMutate l x); - (if N.height l > 2 + N.height r then - (if x < N.key (unsafeCoerce l) then - rotateWithLeftChild nt - else - doubleWithLeftChild nt ) - else nt ) - end - else - begin - N.rightSet nt (addMutate r x); - (if N.height r > 2 + N.height l then - (if N.key (unsafeCoerce r) < x then - rotateWithRightChild nt - else - doubleWithRightChild nt - ) else - nt - ) - end - ) in - let hlt, hrt = N.(height (left t),(height (right t))) in - N.hSet t - N.(Pervasives.max hlt hrt + 1); - N.return t + let l, r = N.(left nt, right nt) in + (if x < k then + N.leftSet nt (addMutate l x) + else + N.rightSet nt (addMutate r x); + ); + N.return (balMutate nt) + + + +let rec removeMutateAux nt (x : elt)= + let k = N.key nt in + if x = k then + let l,r = N.(left nt, right nt) in + match N.(toOpt l, toOpt r) with + | Some _, Some nr -> + N.keySet nt (N.min0Aux nr ); + N.rightSet nt ( removeMutateAux nr x ); (* TODO specalized by removeMinAuxMutate*) + N.return (balMutate nt) + | None, Some _ -> + r + | (Some _ | None ), None -> l + else + begin + if x < k then + match N.toOpt (N.left nt) with + | None -> N.return nt + | Some l -> + N.leftSet nt (removeMutateAux l x ); + N.return (balMutate nt) + else + match N.toOpt (N.right nt) with + | None -> N.return nt + | Some r -> + N.rightSet nt (removeMutateAux r x); + N.return (balMutate nt) end + +let removeMutate nt x = + match N.toOpt nt with + | None -> nt + | Some nt -> removeMutateAux nt x + + let addArrayMutate (t : _ t0) xs = @@ -308,4 +352,3 @@ let ofArray (xs : elt array) : t = result := addMutate !result (A.unsafe_get xs i) done ; !result - \ No newline at end of file diff --git a/jscomp/others/bs_internalSetString.ml b/jscomp/others/bs_internalSetString.ml index e2bb91efb13..991a3b28da8 100644 --- a/jscomp/others/bs_internalSetString.ml +++ b/jscomp/others/bs_internalSetString.ml @@ -57,7 +57,7 @@ let rec split (x : elt) (t : t) : t * bool * t = N.(empty, false, empty) | Some n (* Node(l, v, r, _)*) -> splitAux x n - + let rec mem (t : t) (x : elt) = match N.toOpt t with @@ -139,7 +139,7 @@ let rec eq_aux e1 e2 = | (More _, End) -> false | (More(v1, r1, e1), More(v2, r2, e2)) -> (v1 : elt) = v2 && - eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) + eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) let eq s1 s2 = eq_aux (N.cons_enum s1 End) (N.cons_enum s2 End) @@ -176,8 +176,8 @@ let rec findAssert (x : elt) (n :t) = let v = N.key t in if x = v then Some v else findAssert x N.(if x < v then (left t) else (right t)) - - + + (* @@ -225,7 +225,7 @@ let rotateWithLeftChild k2 = N.(rightSet k1 (return k2 )); let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in N.(hSet k2 - (Pervasives.max hlk2 hrk2 + 1)); + (Pervasives.max hlk2 hrk2 + 1)); let hlk1, hk2 = N.(height (left k1), (h k2)) in N.(hSet k1 (Pervasives.max hlk1 hk2 + 1)); k1 @@ -253,6 +253,32 @@ let doubleWithRightChild k2 = N.(rightSet k2 (return v)); rotateWithRightChild k2 +let heightUpdateMutate t = + let hlt, hrt = N.(height (left t),(height (right t))) in + N.hSet t (Pervasives.max hlt hrt + 1); + t + +let balMutate nt = + let l, r = N.(left nt, right nt) in + if N.height l > 2 + N.height r then + let l = unsafeCoerce l in + let ll, lr = N.(left l , right l)in + (if N.height ll >= N.height lr then + heightUpdateMutate (rotateWithLeftChild nt) + else + heightUpdateMutate (doubleWithLeftChild nt) + ) + else + if N.height r > 2 + N.height l then + let r = unsafeCoerce r in + let rl,rr = N.(left r, right r) in + (if N.height rr >= N.height rl then + heightUpdateMutate (rotateWithRightChild nt) + else + heightUpdateMutate (doubleWithRightChild nt) + ) + else + nt let rec addMutate (t : _ t0) (x : elt)= match N.toOpt t with @@ -261,37 +287,50 @@ let rec addMutate (t : _ t0) (x : elt)= let k = N.key nt in if x = k then t else - begin - let l, r = N.(left nt, right nt) in - let t = - (if x < k then - begin - N.leftSet nt (addMutate l x); - (if N.height l > 2 + N.height r then - (if x < N.key (unsafeCoerce l) then - rotateWithLeftChild nt - else - doubleWithLeftChild nt ) - else nt ) - end - else - begin - N.rightSet nt (addMutate r x); - (if N.height r > 2 + N.height l then - (if N.key (unsafeCoerce r) < x then - rotateWithRightChild nt - else - doubleWithRightChild nt - ) else - nt - ) - end - ) in - let hlt, hrt = N.(height (left t),(height (right t))) in - N.hSet t - N.(Pervasives.max hlt hrt + 1); - N.return t + let l, r = N.(left nt, right nt) in + (if x < k then + N.leftSet nt (addMutate l x) + else + N.rightSet nt (addMutate r x); + ); + N.return (balMutate nt) + + + +let rec removeMutateAux nt (x : elt)= + let k = N.key nt in + if x = k then + let l,r = N.(left nt, right nt) in + match N.(toOpt l, toOpt r) with + | Some _, Some nr -> + N.keySet nt (N.min0Aux nr ); + N.rightSet nt ( removeMutateAux nr x ); (* TODO specalized by removeMinAuxMutate*) + N.return (balMutate nt) + | None, Some _ -> + r + | (Some _ | None ), None -> l + else + begin + if x < k then + match N.toOpt (N.left nt) with + | None -> N.return nt + | Some l -> + N.leftSet nt (removeMutateAux l x ); + N.return (balMutate nt) + else + match N.toOpt (N.right nt) with + | None -> N.return nt + | Some r -> + N.rightSet nt (removeMutateAux r x); + N.return (balMutate nt) end + +let removeMutate nt x = + match N.toOpt nt with + | None -> nt + | Some nt -> removeMutateAux nt x + + let addArrayMutate (t : _ t0) xs = @@ -308,4 +347,3 @@ let ofArray (xs : elt array) : t = result := addMutate !result (A.unsafe_get xs i) done ; !result - \ No newline at end of file diff --git a/jscomp/others/set.cppo.ml b/jscomp/others/set.cppo.ml index a1e361ef3bb..ad010f08eb7 100644 --- a/jscomp/others/set.cppo.ml +++ b/jscomp/others/set.cppo.ml @@ -1,10 +1,10 @@ #ifdef TYPE_STRING type elt = string -#elif defined TYPE_INT + #elif defined TYPE_INT type elt = int -#else -[%error "unknown type"] -#endif + #else + [%error "unknown type"] + #endif module N = Bs_internalAVLset @@ -61,7 +61,7 @@ let rec split (x : elt) (t : t) : t * bool * t = N.(empty, false, empty) | Some n (* Node(l, v, r, _)*) -> splitAux x n - + let rec mem (t : t) (x : elt) = match N.toOpt t with @@ -143,7 +143,7 @@ let rec eq_aux e1 e2 = | (More _, End) -> false | (More(v1, r1, e1), More(v2, r2, e2)) -> (v1 : elt) = v2 && - eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) + eq_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) let eq s1 s2 = eq_aux (N.cons_enum s1 End) (N.cons_enum s2 End) @@ -180,8 +180,8 @@ let rec findAssert (x : elt) (n :t) = let v = N.key t in if x = v then Some v else findAssert x N.(if x < v then (left t) else (right t)) - - + + (* @@ -229,7 +229,7 @@ let rotateWithLeftChild k2 = N.(rightSet k1 (return k2 )); let hlk2, hrk2 = N.(height (left k2), (height (right k2))) in N.(hSet k2 - (Pervasives.max hlk2 hrk2 + 1)); + (Pervasives.max hlk2 hrk2 + 1)); let hlk1, hk2 = N.(height (left k1), (h k2)) in N.(hSet k1 (Pervasives.max hlk1 hk2 + 1)); k1 @@ -257,6 +257,32 @@ let doubleWithRightChild k2 = N.(rightSet k2 (return v)); rotateWithRightChild k2 +let heightUpdateMutate t = + let hlt, hrt = N.(height (left t),(height (right t))) in + N.hSet t (Pervasives.max hlt hrt + 1); + t + +let balMutate nt = + let l, r = N.(left nt, right nt) in + if N.height l > 2 + N.height r then + let l = unsafeCoerce l in + let ll, lr = N.(left l , right l)in + (if N.height ll >= N.height lr then + heightUpdateMutate (rotateWithLeftChild nt) + else + heightUpdateMutate (doubleWithLeftChild nt) + ) + else + if N.height r > 2 + N.height l then + let r = unsafeCoerce r in + let rl,rr = N.(left r, right r) in + (if N.height rr >= N.height rl then + heightUpdateMutate (rotateWithRightChild nt) + else + heightUpdateMutate (doubleWithRightChild nt) + ) + else + nt let rec addMutate (t : _ t0) (x : elt)= match N.toOpt t with @@ -265,37 +291,50 @@ let rec addMutate (t : _ t0) (x : elt)= let k = N.key nt in if x = k then t else - begin - let l, r = N.(left nt, right nt) in - let t = - (if x < k then - begin - N.leftSet nt (addMutate l x); - (if N.height l > 2 + N.height r then - (if x < N.key (unsafeCoerce l) then - rotateWithLeftChild nt - else - doubleWithLeftChild nt ) - else nt ) - end - else - begin - N.rightSet nt (addMutate r x); - (if N.height r > 2 + N.height l then - (if N.key (unsafeCoerce r) < x then - rotateWithRightChild nt - else - doubleWithRightChild nt - ) else - nt - ) - end - ) in - let hlt, hrt = N.(height (left t),(height (right t))) in - N.hSet t - N.(Pervasives.max hlt hrt + 1); - N.return t + let l, r = N.(left nt, right nt) in + (if x < k then + N.leftSet nt (addMutate l x) + else + N.rightSet nt (addMutate r x); + ); + N.return (balMutate nt) + + + +let rec removeMutateAux nt (x : elt)= + let k = N.key nt in + if x = k then + let l,r = N.(left nt, right nt) in + match N.(toOpt l, toOpt r) with + | Some _, Some nr -> + N.keySet nt (N.min0Aux nr ); + N.rightSet nt ( removeMutateAux nr x ); (* TODO specalized by removeMinAuxMutate*) + N.return (balMutate nt) + | None, Some _ -> + r + | (Some _ | None ), None -> l + else + begin + if x < k then + match N.toOpt (N.left nt) with + | None -> N.return nt + | Some l -> + N.leftSet nt (removeMutateAux l x ); + N.return (balMutate nt) + else + match N.toOpt (N.right nt) with + | None -> N.return nt + | Some r -> + N.rightSet nt (removeMutateAux r x); + N.return (balMutate nt) end + +let removeMutate nt x = + match N.toOpt nt with + | None -> nt + | Some nt -> removeMutateAux nt x + + let addArrayMutate (t : _ t0) xs = @@ -312,4 +351,3 @@ let ofArray (xs : elt array) : t = result := addMutate !result (A.unsafe_get xs i) done ; !result - \ No newline at end of file diff --git a/jscomp/test/bs_mutable_set_test.js b/jscomp/test/bs_mutable_set_test.js index e36cc5e7615..8e2adc73d3e 100644 --- a/jscomp/test/bs_mutable_set_test.js +++ b/jscomp/test/bs_mutable_set_test.js @@ -48,6 +48,18 @@ var v$3 = Bs_SetIntM.ofArray(u$1); eq("File \"bs_mutable_set_test.ml\", line 35, characters 5-12", Bs_SetIntM.length(v$3), 100001); +var u$2 = Array_data_util.randomRange(50000, 80000); + +var v$4 = v$3; + +for(var i$1 = 0 ,i_finish = u$2.length - 1 | 0; i$1 <= i_finish; ++i$1){ + v$4 = Bs_SetIntM.remove(v$4, i$1); +} + +var v$5 = v$4; + +eq("File \"bs_mutable_set_test.ml\", line 42, characters 5-12", Bs_SetIntM.length(v$5), 70000); + Mt.from_pair_suites("bs_mutable_set_test.ml", suites[0]); var N = 0; diff --git a/jscomp/test/bs_mutable_set_test.ml b/jscomp/test/bs_mutable_set_test.ml index 2e05214f197..b6adf6bc65b 100644 --- a/jscomp/test/bs_mutable_set_test.ml +++ b/jscomp/test/bs_mutable_set_test.ml @@ -32,6 +32,13 @@ let () = let () = let u = I.randomRange 0 100_000 ++ I.randomRange 0 100 in let v = N.ofArray u in - eq __LOC__ (N.length v) 100_001 - + eq __LOC__ (N.length v) 100_001; + let u = I.randomRange 50_000 80_000 in + let v = ref v in + for i = 0 to A.length u - 1 do + v := N.remove !v i + done; + let v = !v in + eq __LOC__ (N.length v) 70_000 + ;; Mt.from_pair_suites __FILE__ !suites \ No newline at end of file diff --git a/lib/js/bs_SetIntM.js b/lib/js/bs_SetIntM.js index c2bb3c3a02b..10bebcf27d3 100644 --- a/lib/js/bs_SetIntM.js +++ b/lib/js/bs_SetIntM.js @@ -11,6 +11,8 @@ var mem = Bs_internalSetInt.mem; var add = Bs_internalSetInt.addMutate; +var remove = Bs_internalSetInt.removeMutate; + var addArray = Bs_internalSetInt.addArrayMutate; var ofArray = Bs_internalSetInt.ofArray; @@ -27,6 +29,7 @@ exports.empty = empty; exports.isEmpty = isEmpty; exports.mem = mem; exports.add = add; +exports.remove = remove; exports.addArray = addArray; exports.ofArray = ofArray; exports.toArray = toArray; diff --git a/lib/js/bs_internalSetInt.js b/lib/js/bs_internalSetInt.js index 5acbbc13c37..0d182ae4d20 100644 --- a/lib/js/bs_internalSetInt.js +++ b/lib/js/bs_internalSetInt.js @@ -385,6 +385,44 @@ function doubleWithRightChild(k2) { return rotateWithRightChild(k2); } +function heightUpdateMutate(t) { + var hlt = Bs_internalAVLset.height(t.left); + var hrt = Bs_internalAVLset.height(t.right); + t.h = ( + hlt > hrt ? hlt : hrt + ) + 1 | 0; + return t; +} + +function balMutate(nt) { + var l = nt.left; + var r = nt.right; + var hl = Bs_internalAVLset.height(l); + var hr = Bs_internalAVLset.height(r); + if (hl > (2 + hr | 0)) { + var ll = l.left; + var lr = l.right; + if (Bs_internalAVLset.height(ll) >= Bs_internalAVLset.height(lr)) { + return heightUpdateMutate(rotateWithLeftChild(nt)); + } else { + return heightUpdateMutate(doubleWithLeftChild(nt)); + } + } else if (hr > (2 + hl | 0)) { + var rl = r.left; + var rr = r.right; + if (Bs_internalAVLset.height(rr) >= Bs_internalAVLset.height(rl)) { + return heightUpdateMutate(rotateWithRightChild(nt)); + } else { + return heightUpdateMutate(doubleWithRightChild(nt)); + } + } else { + nt.h = ( + hl > hr ? hl : hr + ) + 1 | 0; + return nt; + } +} + function addMutate(t, x) { if (t !== null) { var k = t.key; @@ -393,17 +431,12 @@ function addMutate(t, x) { } else { var l = t.left; var r = t.right; - var t$1 = x < k ? (t.left = addMutate(l, x), Bs_internalAVLset.height(l) > (2 + Bs_internalAVLset.height(r) | 0) ? ( - x < l.key ? rotateWithLeftChild(t) : doubleWithLeftChild(t) - ) : t) : (t.right = addMutate(r, x), Bs_internalAVLset.height(r) > (2 + Bs_internalAVLset.height(l) | 0) ? ( - r.key < x ? rotateWithRightChild(t) : doubleWithRightChild(t) - ) : t); - var hlt = Bs_internalAVLset.height(t$1.left); - var hrt = Bs_internalAVLset.height(t$1.right); - t$1.h = ( - hlt > hrt ? hlt : hrt - ) + 1 | 0; - return t$1; + if (x < k) { + t.left = addMutate(l, x); + } else { + t.right = addMutate(r, x); + } + return balMutate(t); } } else { return { @@ -415,6 +448,51 @@ function addMutate(t, x) { } } +function removeMutateAux(nt, x) { + var k = nt.key; + if (x === k) { + var l = nt.left; + var r = nt.right; + if (l !== null) { + if (r !== null) { + nt.key = Bs_internalAVLset.min0Aux(r); + nt.right = removeMutateAux(r, x); + return balMutate(nt); + } else { + return l; + } + } else if (r !== null) { + return r; + } else { + return l; + } + } else if (x < k) { + var match = nt.left; + if (match !== null) { + nt.left = removeMutateAux(match, x); + return balMutate(nt); + } else { + return nt; + } + } else { + var match$1 = nt.right; + if (match$1 !== null) { + nt.right = removeMutateAux(match$1, x); + return balMutate(nt); + } else { + return nt; + } + } +} + +function removeMutate(nt, x) { + if (nt !== null) { + return removeMutateAux(nt, x); + } else { + return nt; + } +} + function addArrayMutate(t, xs) { var v = t; for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ @@ -456,7 +534,11 @@ exports.rotateWithLeftChild = rotateWithLeftChild; exports.rotateWithRightChild = rotateWithRightChild; exports.doubleWithLeftChild = doubleWithLeftChild; exports.doubleWithRightChild = doubleWithRightChild; +exports.heightUpdateMutate = heightUpdateMutate; +exports.balMutate = balMutate; exports.addMutate = addMutate; +exports.removeMutateAux = removeMutateAux; +exports.removeMutate = removeMutate; exports.addArrayMutate = addArrayMutate; exports.ofArray = ofArray; /* No side effect */ diff --git a/lib/js/bs_internalSetString.js b/lib/js/bs_internalSetString.js index 5acbbc13c37..c33e3887033 100644 --- a/lib/js/bs_internalSetString.js +++ b/lib/js/bs_internalSetString.js @@ -385,6 +385,39 @@ function doubleWithRightChild(k2) { return rotateWithRightChild(k2); } +function heightUpdateMutate(t) { + var hlt = Bs_internalAVLset.height(t.left); + var hrt = Bs_internalAVLset.height(t.right); + t.h = ( + hlt > hrt ? hlt : hrt + ) + 1 | 0; + return t; +} + +function balMutate(nt) { + var l = nt.left; + var r = nt.right; + if (Bs_internalAVLset.height(l) > (2 + Bs_internalAVLset.height(r) | 0)) { + var ll = l.left; + var lr = l.right; + if (Bs_internalAVLset.height(ll) >= Bs_internalAVLset.height(lr)) { + return heightUpdateMutate(rotateWithLeftChild(nt)); + } else { + return heightUpdateMutate(doubleWithLeftChild(nt)); + } + } else if (Bs_internalAVLset.height(r) > (2 + Bs_internalAVLset.height(l) | 0)) { + var rl = r.left; + var rr = r.right; + if (Bs_internalAVLset.height(rr) >= Bs_internalAVLset.height(rl)) { + return heightUpdateMutate(rotateWithRightChild(nt)); + } else { + return heightUpdateMutate(doubleWithRightChild(nt)); + } + } else { + return nt; + } +} + function addMutate(t, x) { if (t !== null) { var k = t.key; @@ -393,17 +426,12 @@ function addMutate(t, x) { } else { var l = t.left; var r = t.right; - var t$1 = x < k ? (t.left = addMutate(l, x), Bs_internalAVLset.height(l) > (2 + Bs_internalAVLset.height(r) | 0) ? ( - x < l.key ? rotateWithLeftChild(t) : doubleWithLeftChild(t) - ) : t) : (t.right = addMutate(r, x), Bs_internalAVLset.height(r) > (2 + Bs_internalAVLset.height(l) | 0) ? ( - r.key < x ? rotateWithRightChild(t) : doubleWithRightChild(t) - ) : t); - var hlt = Bs_internalAVLset.height(t$1.left); - var hrt = Bs_internalAVLset.height(t$1.right); - t$1.h = ( - hlt > hrt ? hlt : hrt - ) + 1 | 0; - return t$1; + if (x < k) { + t.left = addMutate(l, x); + } else { + t.right = addMutate(r, x); + } + return balMutate(t); } } else { return { @@ -415,6 +443,51 @@ function addMutate(t, x) { } } +function removeMutateAux(nt, x) { + var k = nt.key; + if (x === k) { + var l = nt.left; + var r = nt.right; + if (l !== null) { + if (r !== null) { + nt.key = Bs_internalAVLset.min0Aux(r); + nt.right = removeMutateAux(r, x); + return balMutate(nt); + } else { + return l; + } + } else if (r !== null) { + return r; + } else { + return l; + } + } else if (x < k) { + var match = nt.left; + if (match !== null) { + nt.left = removeMutateAux(match, x); + return balMutate(nt); + } else { + return nt; + } + } else { + var match$1 = nt.right; + if (match$1 !== null) { + nt.right = removeMutateAux(match$1, x); + return balMutate(nt); + } else { + return nt; + } + } +} + +function removeMutate(nt, x) { + if (nt !== null) { + return removeMutateAux(nt, x); + } else { + return nt; + } +} + function addArrayMutate(t, xs) { var v = t; for(var i = 0 ,i_finish = xs.length - 1 | 0; i <= i_finish; ++i){ @@ -456,7 +529,11 @@ exports.rotateWithLeftChild = rotateWithLeftChild; exports.rotateWithRightChild = rotateWithRightChild; exports.doubleWithLeftChild = doubleWithLeftChild; exports.doubleWithRightChild = doubleWithRightChild; +exports.heightUpdateMutate = heightUpdateMutate; +exports.balMutate = balMutate; exports.addMutate = addMutate; +exports.removeMutateAux = removeMutateAux; +exports.removeMutate = removeMutate; exports.addArrayMutate = addArrayMutate; exports.ofArray = ofArray; /* No side effect */