From 9c49bf7a4303ae5164383072c1934db10afa9881 Mon Sep 17 00:00:00 2001 From: Hongbo Zhang Date: Sun, 7 Jan 2018 20:59:52 +0800 Subject: [PATCH] add a stack module, better algorithm for set/map comparison --- jscomp/others/.depend | 2 + jscomp/others/Makefile | 1 + jscomp/others/bs.ml | 1 + jscomp/others/bs_Map.ml | 103 ++++++++++--------- jscomp/others/bs_Map.mli | 29 ++++-- jscomp/others/bs_MapInt.ml | 76 ++++++++------ jscomp/others/bs_MapInt.mli | 6 +- jscomp/others/bs_MapString.ml | 76 ++++++++------ jscomp/others/bs_MapString.mli | 6 +- jscomp/others/bs_Queue.ml | 6 +- jscomp/others/bs_Queue.mli | 10 +- jscomp/others/bs_Set.mli | 3 +- jscomp/others/bs_Stack.ml | 100 ++++++++++++++++++ jscomp/others/bs_Stack.mli | 57 +++++++++++ jscomp/others/bs_internalAVLset.ml | 24 ++--- jscomp/others/bs_internalAVLtree.ml | 27 ++--- jscomp/others/bs_internalSet.ml | 36 +++---- jscomp/others/bs_internalSetInt.ml | 122 ++++++++++------------ jscomp/others/bs_internalSetString.ml | 122 ++++++++++------------ jscomp/others/internal_set.cppo.ml | 122 ++++++++++------------ jscomp/others/map.cppo.ml | 76 ++++++++------ jscomp/others/map.cppo.mli | 6 +- jscomp/runtime/js_null.ml | 21 ++-- jscomp/runtime/js_null.mli | 12 ++- jscomp/test/.depend | 1 + jscomp/test/Makefile | 1 + jscomp/test/bs_MapInt_test.js | 2 +- jscomp/test/bs_MapInt_test.ml | 2 +- jscomp/test/bs_hashtbl_string_test.js | 2 +- jscomp/test/bs_hashtbl_string_test.ml | 2 +- jscomp/test/bs_queue_test.js | 46 ++++----- jscomp/test/bs_queue_test.ml | 40 ++++---- jscomp/test/bs_set_int_test.js | 18 ++++ jscomp/test/bs_set_int_test.ml | 15 ++- jscomp/test/bs_stack_test.js | 122 ++++++++++++++++++++++ jscomp/test/bs_stack_test.ml | 135 +++++++++++++++++++++++++ jscomp/test/ffi_test.js | 6 +- jscomp/test/gpr_1245_test.ml | 4 +- jscomp/test/gpr_974_test.ml | 2 +- jscomp/test/js_null_test.js | 4 +- jscomp/test/js_null_test.ml | 10 +- jscomp/test/test_zero_nullable.ml | 14 +-- lib/js/bs.js | 3 + lib/js/bs_Map.js | 140 ++++++++++++++------------ lib/js/bs_MapInt.js | 116 +++++++++++---------- lib/js/bs_MapString.js | 116 +++++++++++---------- lib/js/bs_Queue.js | 6 +- lib/js/bs_Set.js | 2 +- lib/js/bs_SetM.js | 2 +- lib/js/bs_Stack.js | 133 ++++++++++++++++++++++++ lib/js/bs_internalAVLset.js | 31 +++--- lib/js/bs_internalAVLtree.js | 38 +++---- lib/js/bs_internalSet.js | 30 ++++-- lib/js/bs_internalSetInt.js | 87 +++++----------- lib/js/bs_internalSetString.js | 87 +++++----------- lib/js/caml_int64.js | 2 +- lib/js/js_null.js | 14 ++- 57 files changed, 1425 insertions(+), 852 deletions(-) create mode 100644 jscomp/others/bs_Stack.ml create mode 100644 jscomp/others/bs_Stack.mli create mode 100644 jscomp/test/bs_stack_test.js create mode 100644 jscomp/test/bs_stack_test.ml create mode 100644 lib/js/bs_Stack.js diff --git a/jscomp/others/.depend b/jscomp/others/.depend index 4cda5bace7..eb63782c08 100644 --- a/jscomp/others/.depend +++ b/jscomp/others/.depend @@ -59,6 +59,7 @@ bs_SetString.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \ bs_SetString.cmi bs_SetStringM.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \ bs_SetStringM.cmi +bs_Stack.cmj : bs_Stack.cmi node_child_process.cmj : node.cmj js_boolean.cmj : js_boolean.cmi js_math.cmj : @@ -102,6 +103,7 @@ bs_SetInt.cmi : bs_SetIntM.cmi : bs_SetString.cmi : bs_SetStringM.cmi : +bs_Stack.cmi : js_boolean.cmi : js_dict.cmi : js_cast.cmi : diff --git a/jscomp/others/Makefile b/jscomp/others/Makefile index b38273c692..9298bb6b8f 100644 --- a/jscomp/others/Makefile +++ b/jscomp/others/Makefile @@ -43,6 +43,7 @@ SOURCE_LIST= node_path node_fs node_process dict node_module js_array js_string bs_SetIntM\ bs_SetString\ bs_SetStringM\ + bs_Stack\ node_child_process js_boolean js_math\ js_dict js_date js_global js_cast js_promise\ dom dom_storage\ diff --git a/jscomp/others/bs.ml b/jscomp/others/bs.ml index f613c87873..71a3a172d1 100644 --- a/jscomp/others/bs.ml +++ b/jscomp/others/bs.ml @@ -40,6 +40,7 @@ module HashMapString = Bs_HashMapString module HashMultiMap = Bs_HashMultiMap module HashMapInt = Bs_HashMapInt module Sort = Bs_Sort +module Stack = Bs_Stack module Range = Bs_Range module Map = Bs_Map module Set = Bs_Set diff --git a/jscomp/others/bs_Map.ml b/jscomp/others/bs_Map.ml index e63d9482c6..9dffc0fd52 100644 --- a/jscomp/others/bs_Map.ml +++ b/jscomp/others/bs_Map.ml @@ -22,12 +22,6 @@ type ('k,'v,'id) t = - - -type ('key, 'a, 'id) enumeration = ('key, 'a, 'id) N.enumeration0 = - End - | More of 'key * 'a * ('key, 'a, 'id) t0 * ('key, 'a, 'id) enumeration - let empty0 = N.empty0 let isEmpty0 = N.isEmpty0 let singleton0 = N.singleton0 @@ -41,7 +35,7 @@ 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 bindings0 = N.bindings0 let rec add0 ~cmp x data (t : _ t0) = @@ -152,32 +146,42 @@ let rec merge0 ~cmp f s1 s2 = | _ -> assert false - - -let compare0 ~cmp:keycmp cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - let c = (Bs_Cmp.getCmp keycmp) v1 v2 [@bs] in - if c <> 0 then c else - let c = cmp d1 d2 [@bs] in - if c <> 0 then c else - compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in compare_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - -let equal0 ~cmp:keycmp cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - (Bs_Cmp.getCmp keycmp) v1 v2 [@bs] = 0 && cmp d1 d2 [@bs] && - equal_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in equal_aux (N.cons_enum m1 End) (N.cons_enum m2 End) +let rec compareAux e1 e2 ~kcmp ~vcmp = + match e1,e2 with + | h1::t1, h2::t2 -> + let c = (Bs_Cmp.getCmp kcmp) (N.key h1) (N.key h2) [@bs] in + if c = 0 then + let cx = vcmp (N.value h1) (N.value h2) [@bs] in + if cx = 0 then + compareAux ~kcmp ~vcmp + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + else cx + else c + | _, _ -> 0 + +let rec eqAux e1 e2 ~kcmp ~vcmp = + match e1,e2 with + | h1::t1, h2::t2 -> + if (Bs_Cmp.getCmp kcmp) (N.key h1) (N.key h2) [@bs] = 0 && + vcmp (N.value h1) (N.value h2) [@bs] then + eqAux ~kcmp ~vcmp ( + N.stackAllLeft (N.right h1) t1 ) (N.stackAllLeft (N.right h2) t2) + else false + | _, _ -> true (*end *) + + +let cmp0 s1 s2 ~kcmp ~vcmp = + let len1,len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) ~kcmp ~vcmp + else if len1 < len2 then -1 else 1 + +let eq0 s1 s2 ~kcmp ~vcmp = + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + eqAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) ~kcmp ~vcmp + else false let ofArray0 ~cmp (xs : _ array) : _ t0 = @@ -221,8 +225,8 @@ let partition p map = let l,r = partition0 p map in B.bag ~dict ~data:l, B.bag ~dict ~data:r -let cardinal map = - cardinal0 (B.data map) +let length map = + length0 (B.data map) let bindings map = bindings0 (B.data map) @@ -235,12 +239,12 @@ let maxBinding map = let map f map = let dict, map = B.(dict map, data map) in B.bag ~dict ~data:(map0 f map) - + let mapi f map = let dict,map = B.(dict map, data map) in B.bag ~dict ~data:(mapi0 f map ) - + let add (type k) (type v) (type id) key data (map : (k,v,id) t) = @@ -248,13 +252,13 @@ let add (type k) (type v) (type id) key data (map : (k,v,id) t) = let module X = (val dict) in B.bag ~dict ~data:(add0 ~cmp:X.cmp key data map) - + let ofArray (type k) (type v) (type id) (dict : (k,id) Bs_Cmp.t) data = let module M = (val dict ) in B.bag ~dict ~data:(ofArray0 ~cmp:M.cmp data) - + let findOpt (type k) (type v) (type id) x (map : (k,v,id) t) = @@ -284,8 +288,8 @@ let remove (type k) (type v) (type id) x (map : (k,v,id) t) = B.bag ~dict ~data:(remove0 ~cmp:X.cmp x map) let split (type k) (type v) (type id) x (map : (k,v,id) t) = - let dict,map = B.(dict map, data map) in - + let dict,map = B.(dict map, data map) in + let module X = (val dict) in let l,v,r = split0 ~cmp:X.cmp x map in B.bag ~dict @@ -294,7 +298,7 @@ let split (type k) (type v) (type id) x (map : (k,v,id) t) = v , B.bag ~dict ~data:r - + let merge (type k) (type v) (type id) f (s1 : (k,v,id) t) (s2 : (k,_,id) t) = @@ -302,15 +306,18 @@ let merge (type k) (type v) (type id) f (s1 : (k,v,id) t) let module X = (val dict) in B.bag ~data:(merge0 ~cmp:X.cmp f s1_data s2_data ) ~dict - -let compare (type k) (type v) (type id) cmp - (m1 : (k,v,id) t) (m2 : (k,v,id) t) = + +let cmp (type k) (type v) (type id) + (m1 : (k,v,id) t) (m2 : (k,v,id) t) + cmp + = let dict, m1_data, m2_data = B.(dict m1, data m1, data m2) in let module X = (val dict) in - compare0 ~cmp:X.cmp cmp m1_data m2_data + cmp0 ~kcmp:X.cmp ~vcmp:cmp m1_data m2_data -let equal (type k) (type v) (type id) cmp (m1 : (k,v,id) t) (m2 : (k,v,id) t) = +let eq (type k) (type v) (type id) + (m1 : (k,v,id) t) (m2 : (k,v,id) t) cmp = let dict, m1_data, m2_data = B.(dict m1, data m1, data m2) in let module X = (val dict) in - equal0 ~cmp:X.cmp cmp m1_data m2_data \ No newline at end of file + eq0 ~kcmp:X.cmp ~vcmp:cmp m1_data m2_data \ No newline at end of file diff --git a/jscomp/others/bs_Map.mli b/jscomp/others/bs_Map.mli index 654ee427f2..3c77c273a5 100644 --- a/jscomp/others/bs_Map.mli +++ b/jscomp/others/bs_Map.mli @@ -103,16 +103,27 @@ val merge: @since 3.12.0 *) -val compare0: cmp:('k,'id) Bs_Cmp.cmp -> - ('a -> 'a -> int [@bs]) -> ('k, 'a, 'id) t0 -> ('k, 'a, 'id) t0 -> int -val compare: ('a -> 'a -> int [@bs]) -> ('k, 'a, 'id) t -> ('k, 'a, 'id) t -> int +val cmp0: + ('k, 'a, 'id) t0 -> ('k, 'a, 'id) t0 -> + kcmp:('k,'id) Bs_Cmp.cmp -> + vcmp:('a -> 'a -> int [@bs]) -> + int +val cmp: + ('k, 'a, 'id) t -> + ('k, 'a, 'id) t -> + ('a -> 'a -> int [@bs]) -> + int (** Total ordering between maps. The first argument is a total ordering used to compare data associated with equal keys in the two maps. *) -val equal0: cmp: ('k,'id) Bs_Cmp.cmp -> - ('a -> 'a -> bool [@bs]) -> ('k, 'a, 'id) t0 -> ('k, 'a, 'id) t0 -> bool -val equal: ('a -> 'a -> bool [@bs]) -> ('k, 'a, 'id) t -> ('k, 'a, 'id) t -> bool -(** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are +val eq0: + ('k, 'a, 'id) t0 -> + ('k, 'a, 'id) t0 -> + kcmp: ('k,'id) Bs_Cmp.cmp -> + vcmp:('a -> 'a -> bool [@bs]) -> + bool +val eq: ('k, 'a, 'id) t -> ('k, 'a, 'id) t -> ('a -> 'a -> bool [@bs]) -> bool +(** [eq m1 m2 cmp] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare the data associated with the keys. *) @@ -160,8 +171,8 @@ val partition: ('k -> 'a -> bool [@bs]) -> ('k, 'a, 'id) t -> ('k, 'a, 'id) t * @since 3.12.0 *) -val cardinal0: ('k, 'a, 'id) t0 -> int -val cardinal: ('k, 'a, 'id) t -> int +val length0: ('k, 'a, 'id) t0 -> int +val length: ('k, 'a, 'id) t -> int (** Return the number of bindings of a map. @since 3.12.0 *) diff --git a/jscomp/others/bs_MapInt.ml b/jscomp/others/bs_MapInt.ml index 8d7a12da9d..7f875fcaa9 100644 --- a/jscomp/others/bs_MapInt.ml +++ b/jscomp/others/bs_MapInt.ml @@ -8,12 +8,7 @@ type ('key, 'a, 'id) t0 = ('key,'a,'id) N.t0 type + 'a t = (key,'a, unit) N.t0 -type ('key, 'a, 'id) enumeration0 = ('key,'a,'id) N.enumeration0 = - End - | More of 'key * 'a * ('key, 'a, 'id) t0 * ('key, 'a, 'id) enumeration0 -type 'a enumeration = - (key,'a, unit) enumeration0 @@ -30,7 +25,7 @@ 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 bindings = N.bindings0 let checkInvariant = N.checkInvariant @@ -130,30 +125,51 @@ let rec merge f s1 s2 = | _ -> assert false -let compare cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - if (v1 : key) <> v2 then if v1 < v2 then -1 else 1 else - let c = cmp d1 d2 [@bs] in - if c <> 0 then c else - compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in compare_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - -let equal cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - (v1 : key) = v2 && cmp d1 d2 [@bs] && - equal_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in equal_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - +let rec compareAux e1 e2 vcmp = + match e1,e2 with + | h1::t1, h2::t2 -> + let c = Pervasives.compare (N.key h1 : key) (N.key h2) in + if c = 0 then + let cx = vcmp (N.value h1) (N.value h2) [@bs] in + if cx = 0 then + compareAux + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + vcmp + else cx + else c + | _, _ -> 0 + +let cmp s1 s2 cmp = + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux + (N.stackAllLeft s1 []) + (N.stackAllLeft s2 []) + cmp + else if len1 < len2 then -1 + else 1 + + +let rec eqAux e1 e2 eq = + match e1,e2 with + | h1::t1, h2::t2 -> + if (N.key h1 : key) = (N.key h2) && + eq (N.value h1) (N.value h2) [@bs] then + eqAux ( + N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + eq + else false + | _, _ -> true (*end *) + +let eq s1 s2 eq = + let len1,len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + eqAux + (N.stackAllLeft s1 []) + (N.stackAllLeft s2 []) eq + else false let ofArray (xs : _ array) : _ t0 = let result = ref N.empty in diff --git a/jscomp/others/bs_MapInt.mli b/jscomp/others/bs_MapInt.mli index f76aedac63..f68aad2071 100644 --- a/jscomp/others/bs_MapInt.mli +++ b/jscomp/others/bs_MapInt.mli @@ -39,11 +39,11 @@ val merge: @since 3.12.0 *) -val compare: ('a -> 'a -> int [@bs]) -> 'a t -> 'a t -> int +val cmp: 'a t -> 'a t -> ('a -> 'a -> int [@bs]) -> int (** Total ordering between maps. The first argument is a total ordering used to compare data associated with equal keys in the two maps. *) -val equal: ('a -> 'a -> bool [@bs]) -> 'a t -> 'a t -> bool +val eq: 'a t -> 'a t -> ('a -> 'a -> bool [@bs]) -> bool (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare @@ -86,7 +86,7 @@ val partition: (key -> 'a -> bool [@bs]) -> 'a t -> 'a t * 'a t @since 3.12.0 *) -val cardinal: 'a t -> int +val length: 'a t -> int (** Return the number of bindings of a map. @since 3.12.0 *) diff --git a/jscomp/others/bs_MapString.ml b/jscomp/others/bs_MapString.ml index 91dd5f16ca..f9106565ef 100644 --- a/jscomp/others/bs_MapString.ml +++ b/jscomp/others/bs_MapString.ml @@ -8,12 +8,7 @@ type ('key, 'a, 'id) t0 = ('key,'a,'id) N.t0 type + 'a t = (key,'a, unit) N.t0 -type ('key, 'a, 'id) enumeration0 = ('key,'a,'id) N.enumeration0 = - End - | More of 'key * 'a * ('key, 'a, 'id) t0 * ('key, 'a, 'id) enumeration0 -type 'a enumeration = - (key,'a, unit) enumeration0 @@ -30,7 +25,7 @@ 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 bindings = N.bindings0 let checkInvariant = N.checkInvariant @@ -130,30 +125,51 @@ let rec merge f s1 s2 = | _ -> assert false -let compare cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - if (v1 : key) <> v2 then if v1 < v2 then -1 else 1 else - let c = cmp d1 d2 [@bs] in - if c <> 0 then c else - compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in compare_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - -let equal cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - (v1 : key) = v2 && cmp d1 d2 [@bs] && - equal_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in equal_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - +let rec compareAux e1 e2 vcmp = + match e1,e2 with + | h1::t1, h2::t2 -> + let c = Pervasives.compare (N.key h1 : key) (N.key h2) in + if c = 0 then + let cx = vcmp (N.value h1) (N.value h2) [@bs] in + if cx = 0 then + compareAux + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + vcmp + else cx + else c + | _, _ -> 0 + +let cmp s1 s2 cmp = + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux + (N.stackAllLeft s1 []) + (N.stackAllLeft s2 []) + cmp + else if len1 < len2 then -1 + else 1 + + +let rec eqAux e1 e2 eq = + match e1,e2 with + | h1::t1, h2::t2 -> + if (N.key h1 : key) = (N.key h2) && + eq (N.value h1) (N.value h2) [@bs] then + eqAux ( + N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + eq + else false + | _, _ -> true (*end *) + +let eq s1 s2 eq = + let len1,len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + eqAux + (N.stackAllLeft s1 []) + (N.stackAllLeft s2 []) eq + else false let ofArray (xs : _ array) : _ t0 = let result = ref N.empty in diff --git a/jscomp/others/bs_MapString.mli b/jscomp/others/bs_MapString.mli index aa0cda9906..856ee854ea 100644 --- a/jscomp/others/bs_MapString.mli +++ b/jscomp/others/bs_MapString.mli @@ -39,11 +39,11 @@ val merge: @since 3.12.0 *) -val compare: ('a -> 'a -> int [@bs]) -> 'a t -> 'a t -> int +val cmp: 'a t -> 'a t -> ('a -> 'a -> int [@bs]) -> int (** Total ordering between maps. The first argument is a total ordering used to compare data associated with equal keys in the two maps. *) -val equal: ('a -> 'a -> bool [@bs]) -> 'a t -> 'a t -> bool +val eq: 'a t -> 'a t -> ('a -> 'a -> bool [@bs]) -> bool (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare @@ -86,7 +86,7 @@ val partition: (key -> 'a -> bool [@bs]) -> 'a t -> 'a t * 'a t @since 3.12.0 *) -val cardinal: 'a t -> int +val length: 'a t -> int (** Return the number of bindings of a map. @since 3.12.0 *) diff --git a/jscomp/others/bs_Queue.ml b/jscomp/others/bs_Queue.ml index 61edaaf799..a94ae96beb 100644 --- a/jscomp/others/bs_Queue.ml +++ b/jscomp/others/bs_Queue.ml @@ -40,7 +40,7 @@ let clear q = firstSet q null; lastSet q null -let push x q = +let push q x = let cell = return @@ node ~content:x ~next:null @@ -150,7 +150,7 @@ let rec iterAux f cell = f (content x) [@bs]; iterAux f (next x) -let iter f q = +let iter q f = iterAux f (first q) let rec foldAux f accu cell = @@ -160,7 +160,7 @@ let rec foldAux f accu cell = let accu = f accu (content x) [@bs] in foldAux f accu (next x) -let fold f accu q = +let fold q accu f = foldAux f accu (first q) let transfer q1 q2 = diff --git a/jscomp/others/bs_Queue.mli b/jscomp/others/bs_Queue.mli index e280b69115..b47cfe2c6d 100644 --- a/jscomp/others/bs_Queue.mli +++ b/jscomp/others/bs_Queue.mli @@ -27,8 +27,8 @@ val clear : 'a t -> unit val create : unit -> 'a t (** Return a new queue, initially empty. *) -val push : 'a -> 'a t -> unit -(** [push x q] adds the element [x] at the end of the queue [q]. *) +val push : 'a t -> 'a -> unit +(** [push q x] adds the element [x] at the end of the queue [q]. *) val peekOpt : 'a t -> 'a option (** [peekOpt q] returns the first element in queue [q], without removing @@ -56,13 +56,13 @@ val isEmpty : 'a t -> bool val length : 'a t -> int (** Return the number of elements in a queue. *) -val iter : ('a -> unit [@bs]) -> 'a t -> unit +val iter : 'a t -> ('a -> unit [@bs]) -> unit (** [iter f q] applies [f] in turn to all elements of [q], from the least recently entered to the most recently entered. The queue itself is unchanged. *) -val fold : ('b -> 'a -> 'b [@bs]) -> 'b -> 'a t -> 'b -(** [fold f accu q] is equivalent to [List.foldLeft f accu l], +val fold : 'a t -> 'b -> ('b -> 'a -> 'b [@bs]) -> 'b +(** [fold q accu f] is equivalent to [List.foldLeft f accu l], where [l] is the list of [q]'s elements. The queue remains unchanged. *) diff --git a/jscomp/others/bs_Set.mli b/jscomp/others/bs_Set.mli index 3d05fad341..346f35c8f6 100644 --- a/jscomp/others/bs_Set.mli +++ b/jscomp/others/bs_Set.mli @@ -145,8 +145,9 @@ val subset0: ('elt, 'id) t0 -> ('elt, 'id) t0 -> bool val cmp0: + ('elt, 'id) t0 -> ('elt, 'id) t0 -> cmp: ('elt,'id) Bs_Cmp.cmp -> - ('elt, 'id) t0 -> ('elt, 'id) t0 -> int + int val eq0: cmp: ('elt,'id) Bs_Cmp.cmp -> diff --git a/jscomp/others/bs_Stack.ml b/jscomp/others/bs_Stack.ml new file mode 100644 index 0000000000..3dbea0766f --- /dev/null +++ b/jscomp/others/bs_Stack.ml @@ -0,0 +1,100 @@ +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + +type 'a t = { mutable root : 'a opt_cell} +and 'a opt_cell = 'a cell Js.null +and 'a cell = { + head : 'a ; + tail : 'a opt_cell +} [@@bs.deriving abstract] + + +let create () = t ~root:Js.null + +let clear s = rootSet s Js.null + +let copy (s : _ t) : _ t = t ~root:(root s) + +let push s x = + rootSet s (Js.Null.return @@ cell ~head:x ~tail:(root s)) + +let topNull (s : 'a t) : 'a Js.null = + match Js.nullToOption (root s) with + | None -> Js.null + | Some x -> Js.Null.return (head x) + +let topOpt s = + match Js.nullToOption (root s) with + | None -> None + | Some x -> Some (head x) + +let isEmpty s = Js.Null.test (root s) + +let popNull s = + match Js.nullToOption (root s) with + | None -> Js.null + | Some x -> + rootSet s (tail x); + Js.Null.return (head x) + +let popOpt s = + match Js.nullToOption (root s) with + | None -> None + | Some x -> + rootSet s (tail x); + Some (head x) + + + +let rec lengthAux (x : _ cell) acc = + match Js.nullToOption (tail x ) with + | None -> acc + 1 + | Some x -> lengthAux x (acc + 1) + +let length s = + match Js.nullToOption (root s) with + | None -> 0 + | Some x -> lengthAux x 0 + +let rec iterAux (s : _ opt_cell) f = + match Js.nullToOption s with + | None -> () + | Some x -> + f (head x) [@bs]; + iterAux (tail x) f + +let iter s f = + iterAux (root s) f + +let dynamicPopIter s f = + let cursor = ref (root s) in + while !cursor != Js.null do + let v = Js.Null.castUnsafe !cursor in + rootSet s (tail v); + f (head v) [@bs]; + cursor := root s (* using root, [f] may change it*) + done + + diff --git a/jscomp/others/bs_Stack.mli b/jscomp/others/bs_Stack.mli new file mode 100644 index 0000000000..5aa7bfc328 --- /dev/null +++ b/jscomp/others/bs_Stack.mli @@ -0,0 +1,57 @@ +(* Copyright (C) 2017 Authors of BuckleScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) + + +type 'a t + + +val create : unit -> 'a t + +val clear : 'a t -> unit + +val copy : 'a t -> 'a t +(** [copy x] O(1) *) + +val push : 'a t -> 'a -> unit + +val popNull : 'a t -> 'a Js.null + +val popOpt : 'a t -> 'a option + +val topNull : 'a t -> 'a Js.null + +val topOpt : 'a t -> 'a option + +val isEmpty : 'a t -> bool + +val length : 'a t -> int + +val iter : 'a t -> ('a -> unit [@bs]) -> unit + +val dynamicPopIter : 'a t -> ('a -> unit [@bs]) -> unit +(** [dynamicPopIter s f ] + apply [f] to each element of [s]. The item is poped + before applying [f], [s] will be empty after this opeartion +*) + diff --git a/jscomp/others/bs_internalAVLset.ml b/jscomp/others/bs_internalAVLset.ml index e586f58ba0..a2aeb35fe7 100644 --- a/jscomp/others/bs_internalAVLset.ml +++ b/jscomp/others/bs_internalAVLset.ml @@ -17,9 +17,6 @@ type ('elt, 'id) t0 = 'elt node Js.null (* Sets are represented by balanced binary trees (the heights of the children differ by at most 2 *) -type ('elt, 'id)enumeration0 = - | End - | More of 'elt * ('elt, 'id) t0 * ('elt, 'id) enumeration0 let height (n : _ t0) = match toOpt n with @@ -146,12 +143,11 @@ let empty0 = empty let isEmpty0 n = match toOpt n with Some _ -> false | None -> true -let rec toEnum s e = - match toOpt s with - None -> e - | Some n - -> toEnum (left n) (More( key n, right n, e)) - +let rec stackAllLeft v s = + match toOpt v with + | None -> s + | Some x -> stackAllLeft (left x) (x::s) + let rec iter0 n f = match toOpt n with @@ -236,24 +232,24 @@ let rec partition0 n p = then (join lt v rt, concat lf rf) else (concat lt rt, join lf v rf) -let rec cardinalAux n = +let rec lengthAux n = let l, r = left n, right n in let sizeL = match toOpt l with | None -> 0 | Some l -> - cardinalAux l in + lengthAux l in let sizeR = match toOpt r with | None -> 0 - | Some r -> cardinalAux r in + | Some r -> lengthAux r in 1 + sizeL + sizeR let rec length0 n = match toOpt n with | None -> 0 | Some n -> - cardinalAux n + lengthAux n let rec toListAux accu n = match toOpt n with @@ -296,7 +292,7 @@ let toArray0 n = match toOpt n with | None -> [||] | Some n -> - let size = cardinalAux n in + let size = lengthAux n in let v = Bs.Array.makeUninitializedUnsafe size in ignore (fillArray n 0 v : int); (* may add assertion *) v diff --git a/jscomp/others/bs_internalAVLtree.ml b/jscomp/others/bs_internalAVLtree.ml index dc8072e4e0..5ee0ad28df 100644 --- a/jscomp/others/bs_internalAVLtree.ml +++ b/jscomp/others/bs_internalAVLtree.ml @@ -27,9 +27,6 @@ external empty : 'a Js.null = "#null" type ('key, 'a, 'id) t0 = ('key, 'a) node Js.null -type ('key, 'a, 'id) enumeration0 = - End - | More of 'key * 'a * ('key, 'a, 'id) t0 * ('key, 'a, 'id) enumeration0 let height (n : _ t0) = match toOpt n with @@ -244,38 +241,37 @@ let rec partition0 p n = then (join lt v d rt, concat lf rf) else (concat lt rt, join lf v d rf) -let rec cons_enum m e = - match toOpt m with - None -> e - | Some n (* Node(l, v, d, r, _) *) -> - let l, v, d, r = left n, key n, value n, right n in - cons_enum l (More(v, d, r, e)) +let rec stackAllLeft v s = + match toOpt v with + | None -> s + | Some x -> stackAllLeft (left x) (x::s) + -let rec cardinalAux n = +let rec lengthAux n = let l, r = left n, right n in let sizeL = match toOpt l with | None -> 0 | Some l -> - cardinalAux l in + lengthAux l in let sizeR = match toOpt r with | None -> 0 - | Some r -> cardinalAux r in + | Some r -> lengthAux r in 1 + sizeL + sizeR -let rec cardinal0 n = +let rec length0 n = match toOpt n with | None -> 0 | Some n -> - cardinalAux n + lengthAux n let rec bindings_aux accu n = match toOpt n with | None -> accu | Some n (* Node(l, v, d, r, _) *) -> let l, v, d, r = left n, key n, value n, right n in - bindings_aux ((v, d) :: bindings_aux accu r) l + bindings_aux ((v, d) :: bindings_aux accu r) l let bindings0 s = bindings_aux [] s @@ -289,4 +285,3 @@ let rec checkInvariant (v : _ t0) = let diff = height l - height r in diff <=2 && diff >= -2 && checkInvariant l && checkInvariant r - \ No newline at end of file diff --git a/jscomp/others/bs_internalSet.ml b/jscomp/others/bs_internalSet.ml index cbfd4eab79..89ee8ed0da 100644 --- a/jscomp/others/bs_internalSet.ml +++ b/jscomp/others/bs_internalSet.ml @@ -4,12 +4,6 @@ module B = Bs_Bag module A = Bs_Array type ('elt, 'id) t0 = ('elt, 'id) N.t0 -type ('elt, 'id)enumeration = - ('elt, 'id) N.enumeration0 -= - End - | More of 'elt * ('elt, 'id) t0 * ('elt, 'id) enumeration - (* here we relies on reference transparence address equality means everything equal across time @@ -85,22 +79,24 @@ let removeArray0 h arr ~cmp = !v +let rec compareAux e1 e2 ~cmp = + match e1,e2 with + | h1::t1, h2::t2 -> + let c = (Bs_Cmp.getCmp cmp) (N.key h1) (N.key h2) [@bs] in + if c = 0 then + compareAux ~cmp + (N.stackAllLeft (N.right h1) t1) + (N.stackAllLeft (N.right h2) t2) + else c + | _, _ -> 0 + +let cmp0 s1 s2 ~cmp = + let len1,len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux ~cmp (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) + else if len1 < len2 then -1 else 1 -let rec compareAux ~cmp e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, r1, e1), More(v2, r2, e2)) -> - let c = (Bs_Cmp.getCmp cmp) v1 v2 [@bs] in - if c <> 0 - then c - else compareAux ~cmp (N.toEnum r1 e1) (N.toEnum r2 e2) - -let cmp0 ~cmp s1 s2 = - compareAux ~cmp (N.toEnum s1 End) (N.toEnum s2 End) - let eq0 ~cmp s1 s2 = cmp0 ~cmp s1 s2 = 0 diff --git a/jscomp/others/bs_internalSetInt.ml b/jscomp/others/bs_internalSetInt.ml index cd564b8d7b..68d4bea00c 100644 --- a/jscomp/others/bs_internalSetInt.ml +++ b/jscomp/others/bs_internalSetInt.ml @@ -7,15 +7,7 @@ module N = Bs_internalAVLset module A = Bs_Array 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 (t : t) (x : elt) : t = match N.toOpt t with @@ -23,15 +15,15 @@ let rec add (t : t) (x : elt) : t = | Some nt -> let v = N.key nt in if x = v then t else - let l, r = N.(left nt , right nt) in - if x < v then - let ll = add l x in - if ll == l then t - else N.bal ll v r - else - let rr = add r x in - if rr == r then t - else N.bal l v (add r x) + let l, r = N.(left nt , right nt) in + if x < v then + let ll = add l x in + if ll == l then t + else N.bal ll v r + else + let rr = add r x in + if rr == r then t + else N.bal l v (add r x) @@ -66,30 +58,28 @@ let rec remove (t : t) (x : elt) : t = else N.bal l v rr -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.toEnum r1 e1) (N.toEnum r2 e2) +let rec compareAux e1 e2 = + match e1,e2 with + | h1::t1, h2::t2 -> + let (k1 : elt) ,k2 = N.key h1, N.key h2 in + if k1 = k2 then + compareAux + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + else if k1 < k2 then -1 + else 1 + | _, _ -> 0 + let cmp s1 s2 = - compare_aux (N.toEnum s1 End) (N.toEnum s2 End) + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) + else if len1 < len2 then -1 else 1 -let rec eqAux (e1 : enumeration) e2 = - match (e1, e2) with - (End, End) -> true - | (End, More _) -> false - | (More _, End) -> false - | (More(v1, r1, e1), More(v2, r2, e2)) -> - v1 = v2 && - eqAux (N.toEnum r1 e1) (N.toEnum r2 e2) +let eq (s1 : t) s2 = + cmp s1 s2 = 0 -let eq s1 s2 = - eqAux (N.toEnum s1 End) (N.toEnum s2 End) let rec splitAuxNoPivot (n : _ N.node) (x : elt) : t * t = let l,v,r = N.(left n , key n, right n) in @@ -141,7 +131,7 @@ let split (t : t) (x : elt) : t * bool * t = let l,r = splitAuxPivot n x pres in l, !pres, r - + let rec union (s1 : t) (s2 : t) = match N.(toOpt s1, toOpt s2) with (None, _) -> s2 @@ -215,13 +205,7 @@ let rec findOpt (n :t) (x : elt) = if x = v then Some v else findOpt (if x < v then N.left t else N.right t) x -let rec findAssert (n :t) (x : elt) = - match N.toOpt n with - | None -> [%assert "Not_found"] - | Some t -> - let v = N.key t in - if x = v then Some v - else findAssert (if x < v then N.left t else N.right t) x + let rec findNull (n :t) (x : elt) = match N.toOpt n with @@ -240,13 +224,13 @@ let rec addMutate (t : _ t0) (x : elt)= let k = N.key nt in if x = k then t else - 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 (N.balMutate nt) + 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 (N.balMutate nt) @@ -256,27 +240,27 @@ let rec removeMutateAux nt (x : elt)= let l,r = N.(left nt, right nt) in match N.(toOpt l, toOpt r) with | Some _, Some nr -> - N.rightSet nt (N.removeMinAuxMutateWithRoot nt nr); - N.return (N.balMutate nt) + N.rightSet nt (N.removeMinAuxMutateWithRoot nt nr); + N.return (N.balMutate nt) | None, Some _ -> - r + 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 (N.balMutate nt) + match N.toOpt (N.left nt) with + | None -> N.return nt + | Some l -> + N.leftSet nt (removeMutateAux l x ); + N.return (N.balMutate nt) else - match N.toOpt (N.right nt) with - | None -> N.return nt - | Some r -> - N.rightSet nt (removeMutateAux r x); - N.return (N.balMutate nt) - end - + match N.toOpt (N.right nt) with + | None -> N.return nt + | Some r -> + N.rightSet nt (removeMutateAux r x); + N.return (N.balMutate nt) + end + let removeMutate nt x = match N.toOpt nt with | None -> nt @@ -300,7 +284,7 @@ let rec sortedLengthAux (xs : elt array) prec acc len = if v > prec then sortedLengthAux xs v (acc + 1) len else acc - + let ofArray (xs : elt array) = let len = A.length xs in @@ -309,6 +293,6 @@ let ofArray (xs : elt array) = let next = sortedLengthAux xs (A.unsafe_get xs 0) 1 len in let result = ref (N.ofSortedArrayAux xs 0 next) in for i = next to len - 1 do - result := addMutate !result (A.unsafe_get xs i) + result := addMutate !result (A.unsafe_get xs i) done ; !result diff --git a/jscomp/others/bs_internalSetString.ml b/jscomp/others/bs_internalSetString.ml index 4239590e78..f1fb779f7e 100644 --- a/jscomp/others/bs_internalSetString.ml +++ b/jscomp/others/bs_internalSetString.ml @@ -7,15 +7,7 @@ module N = Bs_internalAVLset module A = Bs_Array 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 (t : t) (x : elt) : t = match N.toOpt t with @@ -23,15 +15,15 @@ let rec add (t : t) (x : elt) : t = | Some nt -> let v = N.key nt in if x = v then t else - let l, r = N.(left nt , right nt) in - if x < v then - let ll = add l x in - if ll == l then t - else N.bal ll v r - else - let rr = add r x in - if rr == r then t - else N.bal l v (add r x) + let l, r = N.(left nt , right nt) in + if x < v then + let ll = add l x in + if ll == l then t + else N.bal ll v r + else + let rr = add r x in + if rr == r then t + else N.bal l v (add r x) @@ -66,30 +58,28 @@ let rec remove (t : t) (x : elt) : t = else N.bal l v rr -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.toEnum r1 e1) (N.toEnum r2 e2) +let rec compareAux e1 e2 = + match e1,e2 with + | h1::t1, h2::t2 -> + let (k1 : elt) ,k2 = N.key h1, N.key h2 in + if k1 = k2 then + compareAux + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + else if k1 < k2 then -1 + else 1 + | _, _ -> 0 + let cmp s1 s2 = - compare_aux (N.toEnum s1 End) (N.toEnum s2 End) + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) + else if len1 < len2 then -1 else 1 -let rec eqAux (e1 : enumeration) e2 = - match (e1, e2) with - (End, End) -> true - | (End, More _) -> false - | (More _, End) -> false - | (More(v1, r1, e1), More(v2, r2, e2)) -> - v1 = v2 && - eqAux (N.toEnum r1 e1) (N.toEnum r2 e2) +let eq (s1 : t) s2 = + cmp s1 s2 = 0 -let eq s1 s2 = - eqAux (N.toEnum s1 End) (N.toEnum s2 End) let rec splitAuxNoPivot (n : _ N.node) (x : elt) : t * t = let l,v,r = N.(left n , key n, right n) in @@ -141,7 +131,7 @@ let split (t : t) (x : elt) : t * bool * t = let l,r = splitAuxPivot n x pres in l, !pres, r - + let rec union (s1 : t) (s2 : t) = match N.(toOpt s1, toOpt s2) with (None, _) -> s2 @@ -215,13 +205,7 @@ let rec findOpt (n :t) (x : elt) = if x = v then Some v else findOpt (if x < v then N.left t else N.right t) x -let rec findAssert (n :t) (x : elt) = - match N.toOpt n with - | None -> [%assert "Not_found"] - | Some t -> - let v = N.key t in - if x = v then Some v - else findAssert (if x < v then N.left t else N.right t) x + let rec findNull (n :t) (x : elt) = match N.toOpt n with @@ -240,13 +224,13 @@ let rec addMutate (t : _ t0) (x : elt)= let k = N.key nt in if x = k then t else - 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 (N.balMutate nt) + 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 (N.balMutate nt) @@ -256,27 +240,27 @@ let rec removeMutateAux nt (x : elt)= let l,r = N.(left nt, right nt) in match N.(toOpt l, toOpt r) with | Some _, Some nr -> - N.rightSet nt (N.removeMinAuxMutateWithRoot nt nr); - N.return (N.balMutate nt) + N.rightSet nt (N.removeMinAuxMutateWithRoot nt nr); + N.return (N.balMutate nt) | None, Some _ -> - r + 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 (N.balMutate nt) + match N.toOpt (N.left nt) with + | None -> N.return nt + | Some l -> + N.leftSet nt (removeMutateAux l x ); + N.return (N.balMutate nt) else - match N.toOpt (N.right nt) with - | None -> N.return nt - | Some r -> - N.rightSet nt (removeMutateAux r x); - N.return (N.balMutate nt) - end - + match N.toOpt (N.right nt) with + | None -> N.return nt + | Some r -> + N.rightSet nt (removeMutateAux r x); + N.return (N.balMutate nt) + end + let removeMutate nt x = match N.toOpt nt with | None -> nt @@ -300,7 +284,7 @@ let rec sortedLengthAux (xs : elt array) prec acc len = if v > prec then sortedLengthAux xs v (acc + 1) len else acc - + let ofArray (xs : elt array) = let len = A.length xs in @@ -309,6 +293,6 @@ let ofArray (xs : elt array) = let next = sortedLengthAux xs (A.unsafe_get xs 0) 1 len in let result = ref (N.ofSortedArrayAux xs 0 next) in for i = next to len - 1 do - result := addMutate !result (A.unsafe_get xs i) + result := addMutate !result (A.unsafe_get xs i) done ; !result diff --git a/jscomp/others/internal_set.cppo.ml b/jscomp/others/internal_set.cppo.ml index f94e5b44fc..84938d0c0a 100644 --- a/jscomp/others/internal_set.cppo.ml +++ b/jscomp/others/internal_set.cppo.ml @@ -11,15 +11,7 @@ module N = Bs_internalAVLset module A = Bs_Array 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 (t : t) (x : elt) : t = match N.toOpt t with @@ -27,15 +19,15 @@ let rec add (t : t) (x : elt) : t = | Some nt -> let v = N.key nt in if x = v then t else - let l, r = N.(left nt , right nt) in - if x < v then - let ll = add l x in - if ll == l then t - else N.bal ll v r - else - let rr = add r x in - if rr == r then t - else N.bal l v (add r x) + let l, r = N.(left nt , right nt) in + if x < v then + let ll = add l x in + if ll == l then t + else N.bal ll v r + else + let rr = add r x in + if rr == r then t + else N.bal l v (add r x) @@ -70,30 +62,28 @@ let rec remove (t : t) (x : elt) : t = else N.bal l v rr -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.toEnum r1 e1) (N.toEnum r2 e2) +let rec compareAux e1 e2 = + match e1,e2 with + | h1::t1, h2::t2 -> + let (k1 : elt) ,k2 = N.key h1, N.key h2 in + if k1 = k2 then + compareAux + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + else if k1 < k2 then -1 + else 1 + | _, _ -> 0 + let cmp s1 s2 = - compare_aux (N.toEnum s1 End) (N.toEnum s2 End) + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 []) + else if len1 < len2 then -1 else 1 -let rec eqAux (e1 : enumeration) e2 = - match (e1, e2) with - (End, End) -> true - | (End, More _) -> false - | (More _, End) -> false - | (More(v1, r1, e1), More(v2, r2, e2)) -> - v1 = v2 && - eqAux (N.toEnum r1 e1) (N.toEnum r2 e2) +let eq (s1 : t) s2 = + cmp s1 s2 = 0 -let eq s1 s2 = - eqAux (N.toEnum s1 End) (N.toEnum s2 End) let rec splitAuxNoPivot (n : _ N.node) (x : elt) : t * t = let l,v,r = N.(left n , key n, right n) in @@ -145,7 +135,7 @@ let split (t : t) (x : elt) : t * bool * t = let l,r = splitAuxPivot n x pres in l, !pres, r - + let rec union (s1 : t) (s2 : t) = match N.(toOpt s1, toOpt s2) with (None, _) -> s2 @@ -219,13 +209,7 @@ let rec findOpt (n :t) (x : elt) = if x = v then Some v else findOpt (if x < v then N.left t else N.right t) x -let rec findAssert (n :t) (x : elt) = - match N.toOpt n with - | None -> [%assert "Not_found"] - | Some t -> - let v = N.key t in - if x = v then Some v - else findAssert (if x < v then N.left t else N.right t) x + let rec findNull (n :t) (x : elt) = match N.toOpt n with @@ -244,13 +228,13 @@ let rec addMutate (t : _ t0) (x : elt)= let k = N.key nt in if x = k then t else - 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 (N.balMutate nt) + 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 (N.balMutate nt) @@ -260,27 +244,27 @@ let rec removeMutateAux nt (x : elt)= let l,r = N.(left nt, right nt) in match N.(toOpt l, toOpt r) with | Some _, Some nr -> - N.rightSet nt (N.removeMinAuxMutateWithRoot nt nr); - N.return (N.balMutate nt) + N.rightSet nt (N.removeMinAuxMutateWithRoot nt nr); + N.return (N.balMutate nt) | None, Some _ -> - r + 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 (N.balMutate nt) + match N.toOpt (N.left nt) with + | None -> N.return nt + | Some l -> + N.leftSet nt (removeMutateAux l x ); + N.return (N.balMutate nt) else - match N.toOpt (N.right nt) with - | None -> N.return nt - | Some r -> - N.rightSet nt (removeMutateAux r x); - N.return (N.balMutate nt) - end - + match N.toOpt (N.right nt) with + | None -> N.return nt + | Some r -> + N.rightSet nt (removeMutateAux r x); + N.return (N.balMutate nt) + end + let removeMutate nt x = match N.toOpt nt with | None -> nt @@ -304,7 +288,7 @@ let rec sortedLengthAux (xs : elt array) prec acc len = if v > prec then sortedLengthAux xs v (acc + 1) len else acc - + let ofArray (xs : elt array) = let len = A.length xs in @@ -313,6 +297,6 @@ let ofArray (xs : elt array) = let next = sortedLengthAux xs (A.unsafe_get xs 0) 1 len in let result = ref (N.ofSortedArrayAux xs 0 next) in for i = next to len - 1 do - result := addMutate !result (A.unsafe_get xs i) + result := addMutate !result (A.unsafe_get xs i) done ; !result diff --git a/jscomp/others/map.cppo.ml b/jscomp/others/map.cppo.ml index 7824d1b4de..627ff6df5b 100644 --- a/jscomp/others/map.cppo.ml +++ b/jscomp/others/map.cppo.ml @@ -12,12 +12,7 @@ type ('key, 'a, 'id) t0 = ('key,'a,'id) N.t0 type + 'a t = (key,'a, unit) N.t0 -type ('key, 'a, 'id) enumeration0 = ('key,'a,'id) N.enumeration0 = - End - | More of 'key * 'a * ('key, 'a, 'id) t0 * ('key, 'a, 'id) enumeration0 -type 'a enumeration = - (key,'a, unit) enumeration0 @@ -34,7 +29,7 @@ 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 bindings = N.bindings0 let checkInvariant = N.checkInvariant @@ -134,30 +129,51 @@ let rec merge f s1 s2 = | _ -> assert false -let compare cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - if (v1 : key) <> v2 then if v1 < v2 then -1 else 1 else - let c = cmp d1 d2 [@bs] in - if c <> 0 then c else - compare_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in compare_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - -let equal cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - (v1 : key) = v2 && cmp d1 d2 [@bs] && - equal_aux (N.cons_enum r1 e1) (N.cons_enum r2 e2) - in equal_aux (N.cons_enum m1 End) (N.cons_enum m2 End) - +let rec compareAux e1 e2 vcmp = + match e1,e2 with + | h1::t1, h2::t2 -> + let c = Pervasives.compare (N.key h1 : key) (N.key h2) in + if c = 0 then + let cx = vcmp (N.value h1) (N.value h2) [@bs] in + if cx = 0 then + compareAux + (N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + vcmp + else cx + else c + | _, _ -> 0 + +let cmp s1 s2 cmp = + let len1, len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + compareAux + (N.stackAllLeft s1 []) + (N.stackAllLeft s2 []) + cmp + else if len1 < len2 then -1 + else 1 + + +let rec eqAux e1 e2 eq = + match e1,e2 with + | h1::t1, h2::t2 -> + if (N.key h1 : key) = (N.key h2) && + eq (N.value h1) (N.value h2) [@bs] then + eqAux ( + N.stackAllLeft (N.right h1) t1 ) + (N.stackAllLeft (N.right h2) t2) + eq + else false + | _, _ -> true (*end *) + +let eq s1 s2 eq = + let len1,len2 = N.length0 s1, N.length0 s2 in + if len1 = len2 then + eqAux + (N.stackAllLeft s1 []) + (N.stackAllLeft s2 []) eq + else false let ofArray (xs : _ array) : _ t0 = let result = ref N.empty in diff --git a/jscomp/others/map.cppo.mli b/jscomp/others/map.cppo.mli index 8ad8fc0559..b4eb6809ab 100644 --- a/jscomp/others/map.cppo.mli +++ b/jscomp/others/map.cppo.mli @@ -43,11 +43,11 @@ val merge: @since 3.12.0 *) -val compare: ('a -> 'a -> int [@bs]) -> 'a t -> 'a t -> int +val cmp: 'a t -> 'a t -> ('a -> 'a -> int [@bs]) -> int (** Total ordering between maps. The first argument is a total ordering used to compare data associated with equal keys in the two maps. *) -val equal: ('a -> 'a -> bool [@bs]) -> 'a t -> 'a t -> bool +val eq: 'a t -> 'a t -> ('a -> 'a -> bool [@bs]) -> bool (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare @@ -90,7 +90,7 @@ val partition: (key -> 'a -> bool [@bs]) -> 'a t -> 'a t * 'a t @since 3.12.0 *) -val cardinal: 'a t -> int +val length: 'a t -> int (** Return the number of bindings of a map. @since 3.12.0 *) diff --git a/jscomp/runtime/js_null.ml b/jscomp/runtime/js_null.ml index bffccda9ac..6391e603ee 100644 --- a/jscomp/runtime/js_null.ml +++ b/jscomp/runtime/js_null.ml @@ -24,26 +24,33 @@ (** Provides functionality for dealing with the ['a Js.null] type *) -(*tag::interface_all[]*) + type + 'a t = 'a Js.null -external to_opt : 'a t -> 'a option = "#null_to_opt" + external toOption : 'a t -> 'a option = "#null_to_opt" external return : 'a -> 'a t = "%identity" external test : 'a t -> bool = "#is_nil" -external empty : 'a t = "null" [@@bs.val] -(*end::interface_all[]*) +external empty : 'a t = "#null" +external castUnsafe : 'a t -> 'a = "%identity" +let castExn f = + match toOption f with + | None -> [%assert "null"] + | Some x -> x + let bind x f = - match to_opt x with + match toOption x with | None -> empty | Some x -> return (f x [@bs]) let iter x f = - match to_opt x with + match toOption x with | None -> () | Some x -> f x [@bs] -let from_opt x = +let fromOption x = match x with | None -> empty | Some x -> return x + +let from_opt = fromOption \ No newline at end of file diff --git a/jscomp/runtime/js_null.mli b/jscomp/runtime/js_null.mli index 40876bcbbd..9c34b79090 100644 --- a/jscomp/runtime/js_null.mli +++ b/jscomp/runtime/js_null.mli @@ -35,9 +35,13 @@ external return : 'a -> 'a t = "%identity" external test : 'a t -> bool = "#is_nil" (** The empty value, [null] *) -external empty : 'a t = "null" [@@bs.val] +external empty : 'a t = "#null" +external castUnsafe : 'a t -> 'a = "%identity" + +val castExn : 'a t -> 'a + (** Maps the contained value using the given function If ['a Js.null] contains a value, that value is unwrapped, mapped to a ['b] using @@ -71,7 +75,10 @@ val iter : 'a t -> ('a -> unit [@bs]) -> unit %} *) +val fromOption: 'a option -> 'a t + val from_opt : 'a option -> 'a t +[@@ocaml.deprecated "Use fromOpiton instead"] (** Maps ['a Js.null] to ['a option] @@ -84,5 +91,4 @@ val from_opt : 'a option -> 'a t *) external toOption : 'a t -> 'a option = "#null_to_opt" -external to_opt : 'a t -> 'a option = "#null_to_opt" -[@@deprecated "use toOption instead"] + diff --git a/jscomp/test/.depend b/jscomp/test/.depend index 56dcd43fd7..44b016db22 100644 --- a/jscomp/test/.depend +++ b/jscomp/test/.depend @@ -117,6 +117,7 @@ bs_set_int_test.cmj : mt.cmj ../stdlib/list.cmj ../runtime/js.cmj \ bs_sort_test.cmj : mt.cmj ../others/bs_Range.cmj ../others/bs.cmj \ array_data_util.cmj bs_splice_partial.cmj : ../runtime/js.cmj +bs_stack_test.cmj : ../runtime/js.cmj ../others/bs.cmj bs_string_test.cmj : mt.cmj ../runtime/js.cmj bs_unwrap_test.cmj : ../runtime/js.cmj buffer_test.cmj : ../stdlib/string.cmj mt.cmj ../stdlib/bytes.cmj \ diff --git a/jscomp/test/Makefile b/jscomp/test/Makefile index e3d28dbf46..1cabd2b0f3 100644 --- a/jscomp/test/Makefile +++ b/jscomp/test/Makefile @@ -233,6 +233,7 @@ OTHERS := test_literals a test_ari test_export2 test_internalOO test_obj_simple_ equal_box_test\ bs_poly_mutable_set_test\ bs_poly_set_test\ + bs_stack_test\ # bs_uncurry_test # needs Lam to get rid of Uncurry arity first # simple_derive_test diff --git a/jscomp/test/bs_MapInt_test.js b/jscomp/test/bs_MapInt_test.js index cf8b43f243..0bbb157c76 100644 --- a/jscomp/test/bs_MapInt_test.js +++ b/jscomp/test/bs_MapInt_test.js @@ -21,7 +21,7 @@ function test() { for(var i$2 = 0; i$2 <= 999999; ++i$2){ m = Bs_MapInt.remove(i$2, m); } - return should(+(Bs_MapInt.cardinal(m) === 0)); + return should(+(Bs_MapInt.length(m) === 0)); } test(/* () */0); diff --git a/jscomp/test/bs_MapInt_test.ml b/jscomp/test/bs_MapInt_test.ml index 12c23801fb..3ef0857f59 100644 --- a/jscomp/test/bs_MapInt_test.ml +++ b/jscomp/test/bs_MapInt_test.ml @@ -12,7 +12,7 @@ let test () = for i = 0 to count do m := Bs.MapInt.remove i !m ; done ; - should (Bs.MapInt.cardinal !m = 0) + should (Bs.MapInt.length !m = 0) let () = test () diff --git a/jscomp/test/bs_hashtbl_string_test.js b/jscomp/test/bs_hashtbl_string_test.js index be7ae5ef42..edf9f64a47 100644 --- a/jscomp/test/bs_hashtbl_string_test.js +++ b/jscomp/test/bs_hashtbl_string_test.js @@ -164,7 +164,7 @@ function bench3(m) { for(var i$2 = 0; i$2 <= 1000000; ++i$2){ table = Bs_Map.remove0(cmp, "" + i$2, table); } - if (Bs_Map.cardinal0(table)) { + if (Bs_Map.length0(table)) { throw [ Caml_builtin_exceptions.assert_failure, [ diff --git a/jscomp/test/bs_hashtbl_string_test.ml b/jscomp/test/bs_hashtbl_string_test.ml index 76e1d130b6..6f108bf17b 100644 --- a/jscomp/test/bs_hashtbl_string_test.ml +++ b/jscomp/test/bs_hashtbl_string_test.ml @@ -100,7 +100,7 @@ let bench3 (type t) (m : (string,t) Bs.Cmp.t) = for i = 0 to count do table := Bs.Map.remove0 ~cmp (string_of_int i) !table done ; - assert (Bs.Map.cardinal0 !table = 0) + assert (Bs.Map.length0 !table = 0) module Sx = (val Bs.Cmp.make (fun [@bs] (x : string) y -> compare x y )) diff --git a/jscomp/test/bs_queue_test.js b/jscomp/test/bs_queue_test.js index ecadb78a3e..6f3e82a236 100644 --- a/jscomp/test/bs_queue_test.js +++ b/jscomp/test/bs_queue_test.js @@ -29,7 +29,7 @@ if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[]) && q.length == ]; } -Bs_Queue.push(1, q); +Bs_Queue.push(q, 1); if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[1]) && q.length === 1)) { throw [ @@ -42,7 +42,7 @@ if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[1]) && q.length = ]; } -Bs_Queue.push(2, q); +Bs_Queue.push(q, 2); if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[ 1, @@ -58,7 +58,7 @@ if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[ ]; } -Bs_Queue.push(3, q); +Bs_Queue.push(q, 3); if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[ 1, @@ -75,7 +75,7 @@ if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[ ]; } -Bs_Queue.push(4, q); +Bs_Queue.push(q, 4); if (!(Caml_obj.caml_equal(Bs_Queue.toArray(q), /* int array */[ 1, @@ -201,7 +201,7 @@ if (!does_raise(Bs_Queue.popAssert, q)) { var q$1 = Bs_Queue.create(/* () */0); -Bs_Queue.push(1, q$1); +Bs_Queue.push(q$1, 1); if (Bs_Queue.popAssert(q$1) !== 1) { throw [ @@ -225,7 +225,7 @@ if (!does_raise(Bs_Queue.popAssert, q$1)) { ]; } -Bs_Queue.push(2, q$1); +Bs_Queue.push(q$1, 2); if (Bs_Queue.popAssert(q$1) !== 2) { throw [ @@ -262,7 +262,7 @@ if (q$1.length !== 0) { var q$2 = Bs_Queue.create(/* () */0); -Bs_Queue.push(1, q$2); +Bs_Queue.push(q$2, 1); if (Bs_Queue.peekAssert(q$2) !== 1) { throw [ @@ -275,7 +275,7 @@ if (Bs_Queue.peekAssert(q$2) !== 1) { ]; } -Bs_Queue.push(2, q$2); +Bs_Queue.push(q$2, 2); if (Bs_Queue.peekAssert(q$2) !== 1) { throw [ @@ -288,7 +288,7 @@ if (Bs_Queue.peekAssert(q$2) !== 1) { ]; } -Bs_Queue.push(3, q$2); +Bs_Queue.push(q$2, 3); if (Bs_Queue.peekAssert(q$2) !== 1) { throw [ @@ -392,7 +392,7 @@ if (!does_raise(Bs_Queue.peekAssert, q$2)) { var q$3 = Bs_Queue.create(/* () */0); for(var i = 1; i <= 10; ++i){ - Bs_Queue.push(i, q$3); + Bs_Queue.push(q$3, i); } Bs_Queue.clear(q$3); @@ -430,7 +430,7 @@ if (!Caml_obj.caml_equal(q$3, Bs_Queue.create(/* () */0))) { ]; } -Bs_Queue.push(42, q$3); +Bs_Queue.push(q$3, 42); if (Bs_Queue.popAssert(q$3) !== 42) { throw [ @@ -446,7 +446,7 @@ if (Bs_Queue.popAssert(q$3) !== 42) { var q1 = Bs_Queue.create(/* () */0); for(var i$1 = 1; i$1 <= 10; ++i$1){ - Bs_Queue.push(i$1, q1); + Bs_Queue.push(q1, i$1); } var q2 = Bs_Queue.copy(q1); @@ -559,7 +559,7 @@ if (q$4.length !== 0) { } for(var i$4 = 1; i$4 <= 10; ++i$4){ - Bs_Queue.push(i$4, q$4); + Bs_Queue.push(q$4, i$4); if (q$4.length !== i$4) { throw [ Caml_builtin_exceptions.assert_failure, @@ -632,25 +632,25 @@ if (q$4.length !== 0) { var q$5 = Bs_Queue.create(/* () */0); for(var i$6 = 1; i$6 <= 10; ++i$6){ - Bs_Queue.push(i$6, q$5); + Bs_Queue.push(q$5, i$6); } var i$7 = [1]; -Bs_Queue.iter((function (j) { +Bs_Queue.iter(q$5, (function (j) { if (i$7[0] !== j) { throw [ Caml_builtin_exceptions.assert_failure, [ "bs_queue_test.ml", 94, - 24 + 26 ] ]; } i$7[0] = i$7[0] + 1 | 0; return /* () */0; - }), q$5); + })); var q1$1 = Bs_Queue.create(/* () */0); @@ -751,7 +751,7 @@ var q1$2 = Bs_Queue.create(/* () */0); var q2$2 = Bs_Queue.create(/* () */0); for(var i$8 = 1; i$8 <= 4; ++i$8){ - Bs_Queue.push(i$8, q1$2); + Bs_Queue.push(q1$2, i$8); } if (q1$2.length !== 4) { @@ -859,7 +859,7 @@ var q1$3 = Bs_Queue.create(/* () */0); var q2$3 = Bs_Queue.create(/* () */0); for(var i$9 = 5; i$9 <= 8; ++i$9){ - Bs_Queue.push(i$9, q2$3); + Bs_Queue.push(q2$3, i$9); } if (q1$3.length !== 0) { @@ -967,11 +967,11 @@ var q1$4 = Bs_Queue.create(/* () */0); var q2$4 = Bs_Queue.create(/* () */0); for(var i$10 = 1; i$10 <= 4; ++i$10){ - Bs_Queue.push(i$10, q1$4); + Bs_Queue.push(q1$4, i$10); } for(var i$11 = 5; i$11 <= 8; ++i$11){ - Bs_Queue.push(i$11, q2$4); + Bs_Queue.push(q2$4, i$11); } if (q1$4.length !== 4) { @@ -1085,9 +1085,9 @@ if (!Caml_obj.caml_equal(Bs_Queue.toArray(q2$4), v)) { ]; } -if (Bs_Queue.fold((function (x, y) { +if (Bs_Queue.fold(q2$4, 0, (function (x, y) { return x - y | 0; - }), 0, q2$4) !== Bs_Array.foldLeft(v, 0, (function (x, y) { + })) !== Bs_Array.foldLeft(v, 0, (function (x, y) { return x - y | 0; }))) { throw [ diff --git a/jscomp/test/bs_queue_test.ml b/jscomp/test/bs_queue_test.ml index 5d203dc62d..314bee8fc3 100644 --- a/jscomp/test/bs_queue_test.ml +++ b/jscomp/test/bs_queue_test.ml @@ -13,10 +13,10 @@ let does_raise f q = let () = let q = Q.create () in (); assert (Q.toArray q = [| |] && Q.length q = 0); - Q.push 1 q; assert (Q.toArray q = [|1 |] && Q.length q = 1); - Q.push 2 q; assert (Q.toArray q = [|1; 2 |] && Q.length q = 2); - Q.push 3 q; assert (Q.toArray q = [|1; 2; 3 |] && Q.length q = 3); - Q.push 4 q; assert (Q.toArray q = [|1; 2; 3; 4|] && Q.length q = 4); + Q.push q 1; assert (Q.toArray q = [|1 |] && Q.length q = 1); + Q.push q 2; assert (Q.toArray q = [|1; 2 |] && Q.length q = 2); + Q.push q 3; assert (Q.toArray q = [|1; 2; 3 |] && Q.length q = 3); + Q.push q 4; assert (Q.toArray q = [|1; 2; 3; 4|] && Q.length q = 4); assert (Q.popAssert q = 1); assert (Q.toArray q = [| 2; 3; 4|] && Q.length q = 3); assert (Q.popAssert q = 2); assert (Q.toArray q = [| 3; 4|] && Q.length q = 2); assert (Q.popAssert q = 3); assert (Q.toArray q = [| 4|] && Q.length q = 1); @@ -26,16 +26,16 @@ let () = let () = let q = Q.create () in - Q.push 1 q; assert (Q.popAssert q = 1); assert (does_raise Q.popAssert q); - Q.push 2 q; assert (Q.popAssert q = 2); assert (does_raise Q.popAssert q); + Q.push q 1; assert (Q.popAssert q = 1); assert (does_raise Q.popAssert q); + Q.push q 2; assert (Q.popAssert q = 2); assert (does_raise Q.popAssert q); assert (Q.length q = 0); ;; let () = let q = Q.create () in - Q.push 1 q; assert (Q.peekAssert q = 1); - Q.push 2 q; assert (Q.peekAssert q = 1); - Q.push 3 q; assert (Q.peekAssert q = 1); + Q.push q 1; assert (Q.peekAssert q = 1); + Q.push q 2; assert (Q.peekAssert q = 1); + Q.push q 3; assert (Q.peekAssert q = 1); assert (Q.peekAssert q = 1); assert (Q.popAssert q = 1); assert (Q.peekAssert q = 2); assert (Q.popAssert q = 2); assert (Q.peekAssert q = 3); assert (Q.popAssert q = 3); @@ -45,18 +45,18 @@ let () = let () = let q = Q.create () in - for i = 1 to 10 do Q.push i q done; + for i = 1 to 10 do Q.push q i done; Q.clear q; assert (Q.length q = 0); assert (does_raise Q.popAssert q); assert (q = Q.create ()); - Q.push 42 q; + Q.push q 42; assert (Q.popAssert q = 42); ;; let () = let q1 = Q.create () in - for i = 1 to 10 do Q.push i q1 done; + for i = 1 to 10 do Q.push q1 i done; let q2 = Q.copy q1 in assert (Q.toArray q1 = [|1; 2; 3; 4; 5; 6; 7; 8; 9; 10|]); assert (Q.toArray q2 = [|1; 2; 3; 4; 5; 6; 7; 8; 9; 10|]); @@ -74,7 +74,7 @@ let () = let q = Q.create () in assert (Q.isEmpty q); for i = 1 to 10 do - Q.push i q; + Q.push q i; assert (Q.length q = i); assert (not (Q.isEmpty q)); done; @@ -89,9 +89,9 @@ let () = let () = let q = Q.create () in - for i = 1 to 10 do Q.push i q done; + for i = 1 to 10 do Q.push q i done; let i = ref 1 in - Q.iter (fun[@bs] j -> assert (!i = j); incr i) q; + Q.iter q (fun[@bs] j -> assert (!i = j); incr i); ;; let () = @@ -105,7 +105,7 @@ let () = let () = let q1 = Q.create () and q2 = Q.create () in - for i = 1 to 4 do Q.push i q1 done; + for i = 1 to 4 do Q.push q1 i done; assert (Q.length q1 = 4); assert (Q.toArray q1 = [|1; 2; 3; 4|]); assert (Q.length q2 = 0); assert (Q.toArray q2 = [| |]); Q.transfer q1 q2; @@ -115,7 +115,7 @@ let () = let () = let q1 = Q.create () and q2 = Q.create () in - for i = 5 to 8 do Q.push i q2 done; + for i = 5 to 8 do Q.push q2 i done; assert (Q.length q1 = 0); assert (Q.toArray q1 = [| |]); assert (Q.length q2 = 4); assert (Q.toArray q2 = [|5; 6; 7; 8|]); Q.transfer q1 q2; @@ -125,8 +125,8 @@ let () = let () = let q1 = Q.create () and q2 = Q.create () in - for i = 1 to 4 do Q.push i q1 done; - for i = 5 to 8 do Q.push i q2 done; + for i = 1 to 4 do Q.push q1 i done; + for i = 5 to 8 do Q.push q2 i done; assert (Q.length q1 = 4); assert (Q.toArray q1 = [|1; 2; 3; 4|]); assert (Q.length q2 = 4); assert (Q.toArray q2 = [|5; 6; 7; 8|]); Q.transfer q1 q2; @@ -134,7 +134,7 @@ let () = let v = [|5; 6; 7; 8; 1; 2; 3; 4|] in assert (Q.length q2 = 8); assert (Q.toArray q2 = v ); - assert (Q.fold (fun[@bs] x y -> x - y ) 0 q2 = + assert (Q.fold q2 0 (fun[@bs] x y -> x - y ) = Bs.Array.foldLeft v 0 (fun [@bs] x y -> x - y) ) ;; diff --git a/jscomp/test/bs_set_int_test.js b/jscomp/test/bs_set_int_test.js index cbe91e0c81..f850fb49d1 100644 --- a/jscomp/test/bs_set_int_test.js +++ b/jscomp/test/bs_set_int_test.js @@ -245,6 +245,24 @@ b("File \"bs_set_int_test.ml\", line 119, characters 4-11", +(Bs_SetInt.add(dd, b("File \"bs_set_int_test.ml\", line 120, characters 4-11", 1 - Bs_SetInt.subset(Bs_SetInt.add(dd, 201), bb)); +var aa$1 = Bs_SetInt.ofArray(Array_data_util.randomRange(0, 100)); + +var bb$1 = Bs_SetInt.ofArray(Array_data_util.randomRange(0, 100)); + +var cc$1 = Bs_SetInt.add(bb$1, 101); + +var dd$1 = Bs_SetInt.remove(bb$1, 99); + +var ee = Bs_SetInt.add(dd$1, 101); + +b("File \"bs_set_int_test.ml\", line 129, characters 4-11", Bs_SetInt.eq(aa$1, bb$1)); + +b("File \"bs_set_int_test.ml\", line 130, characters 4-11", 1 - Bs_SetInt.eq(aa$1, cc$1)); + +b("File \"bs_set_int_test.ml\", line 131, characters 4-11", 1 - Bs_SetInt.eq(dd$1, cc$1)); + +b("File \"bs_set_int_test.ml\", line 132, characters 4-11", 1 - Bs_SetInt.eq(bb$1, ee)); + Mt.from_pair_suites("bs_set_int_test.ml", suites[0]); var N = 0; diff --git a/jscomp/test/bs_set_int_test.ml b/jscomp/test/bs_set_int_test.ml index 6bc6f69143..0344ff4e6f 100644 --- a/jscomp/test/bs_set_int_test.ml +++ b/jscomp/test/bs_set_int_test.ml @@ -117,6 +117,19 @@ let () = b __LOC__ (N.subset (N.add dd 200) bb); b __LOC__ (N.add dd 200 == dd); b __LOC__ (N.add dd 0 == dd); - b __LOC__ (not (N.subset (N.add dd 201) bb)); + b __LOC__ (not (N.subset (N.add dd 201) bb)) + + +let () = + let aa = N.ofArray (I.randomRange 0 100) in + let bb = N.ofArray (I.randomRange 0 100) in + let cc = N.add bb 101 in + let dd = N.remove bb 99 in + let ee = N.add dd 101 in + b __LOC__ (N.eq aa bb ); + b __LOC__ (not (N.eq aa cc)); + b __LOC__ (not (N.eq dd cc)); + b __LOC__ (not (N.eq bb ee)); + ;; Mt.from_pair_suites __FILE__ !suites \ No newline at end of file diff --git a/jscomp/test/bs_stack_test.js b/jscomp/test/bs_stack_test.js new file mode 100644 index 0000000000..ba918226c2 --- /dev/null +++ b/jscomp/test/bs_stack_test.js @@ -0,0 +1,122 @@ +'use strict'; + +var Js_null = require("../../lib/js/js_null.js"); +var Bs_Queue = require("../../lib/js/bs_Queue.js"); +var Bs_Stack = require("../../lib/js/bs_Stack.js"); + +function inOrder(v) { + var current = v; + var s = { + root: null + }; + var q = Bs_Queue.create(/* () */0); + while(current !== null) { + var v$1 = current; + Bs_Stack.push(s, v$1); + current = v$1.left; + }; + while(s.root !== null) { + current = Bs_Stack.popNull(s); + var v$2 = current; + Bs_Queue.push(q, v$2.value); + current = v$2.right; + while(current !== null) { + var v$3 = current; + Bs_Stack.push(s, v$3); + current = v$3.left; + }; + }; + return Bs_Queue.toArray(q); +} + +function inOrder3(v) { + var current = v; + var s = { + root: null + }; + var q = Bs_Queue.create(/* () */0); + while(current !== null) { + var v$1 = current; + Bs_Stack.push(s, v$1); + current = v$1.left; + }; + Bs_Stack.dynamicPopIter(s, (function (popped) { + Bs_Queue.push(q, popped.value); + var current = popped.right; + while(current !== null) { + var v = current; + Bs_Stack.push(s, v); + current = v.left; + }; + return /* () */0; + })); + return Bs_Queue.toArray(q); +} + +function inOrder2(v) { + var todo = /* true */1; + var cursor = v; + var s = { + root: null + }; + var q = Bs_Queue.create(/* () */0); + while(todo) { + if (cursor !== null) { + var v$1 = cursor; + Bs_Stack.push(s, v$1); + cursor = v$1.left; + } else if (s.root !== null) { + cursor = Bs_Stack.popNull(s); + var current = cursor; + Bs_Queue.push(q, current.value); + cursor = current.right; + } else { + todo = /* false */0; + } + }; + return /* () */0; +} + +function n(l, r, a) { + return { + value: a, + left: Js_null.fromOption(l), + right: Js_null.fromOption(r) + }; +} + +var test1 = n(/* Some */[n(/* Some */[n(/* None */0, /* None */0, 4)], /* Some */[n(/* None */0, /* None */0, 5)], 2)], /* Some */[n(/* None */0, /* None */0, 3)], 1); + +function pushAllLeft(st1, s1) { + var current = st1; + while(current !== null) { + var v = current; + Bs_Stack.push(s1, v); + current = v.left; + }; + return /* () */0; +} + +var test2 = n(/* Some */[n(/* Some */[n(/* Some */[n(/* Some */[n(/* None */0, /* None */0, 4)], /* None */0, 2)], /* None */0, 5)], /* None */0, 1)], /* None */0, 3); + +var test3 = n(/* Some */[n(/* Some */[n(/* Some */[n(/* None */0, /* None */0, 4)], /* None */0, 2)], /* None */0, 5)], /* Some */[n(/* None */0, /* None */0, 3)], 1); + +console.log(inOrder(test1)); + +console.log(inOrder3(test1)); + +var S = 0; + +var Q = 0; + +exports.S = S; +exports.Q = Q; +exports.inOrder = inOrder; +exports.inOrder3 = inOrder3; +exports.inOrder2 = inOrder2; +exports.n = n; +exports.test1 = test1; +exports.pushAllLeft = pushAllLeft; +exports.test2 = test2; +exports.test3 = test3; +/* test1 Not a pure module */ diff --git a/jscomp/test/bs_stack_test.ml b/jscomp/test/bs_stack_test.ml new file mode 100644 index 0000000000..3567d061ba --- /dev/null +++ b/jscomp/test/bs_stack_test.ml @@ -0,0 +1,135 @@ + + +type node = { + value : int ; + left : t; + right : t +} +and t = node Js.null +[@@bs.deriving abstract] + + + +module S = Bs.Stack +module Q = Bs.Queue + +let inOrder (v : t) = + let current = ref v in + let s : node S.t = S.create () in + let q : int Q.t = Q.create () in + while !current != Js.null do + let v = Js.Null.castUnsafe !current in + S.push s v; + current := left v; + done ; + while not (S.isEmpty s ) do + current := S.popNull s ; + let v = Js.Null.castUnsafe !current in + Q.push q (value v); + current := right v ; + while !current != Js.null do + let v = Js.Null.castUnsafe !current in + S.push s v; + current := left v; + done ; + done; + Q.toArray q + +let inOrder3 (v : t) = + let current = ref v in + let s : node S.t = S.create () in + let q : int Q.t = Q.create () in + while !current != Js.null do + let v = Js.Null.castUnsafe !current in + S.push s v; + current := left v; + done ; + S.dynamicPopIter s begin fun [@bs] popped -> + Q.push q (value popped); + let current = ref (right popped) in + while !current != Js.null do + let v = Js.Null.castUnsafe !current in + S.push s v; + current := left v + done + end; + Q.toArray q + +let inOrder2 (v : t) = + let todo = ref true in + let cursor = ref v in + let s : node S.t = S.create () in + let q : int Q.t = Q.create () in + while !todo do + if !cursor != Js.null then + ( + let v = (Js.Null.castUnsafe !cursor) in + S.push s v; + cursor := left v) + else + begin + if not (S.isEmpty s) then + (cursor := S.popNull s ; + let current = Js.Null.castUnsafe !cursor in + Q.push q (value current); + cursor := right current) + else + todo := false + end + done + +let n + ?l ?r a = + node ~value:a + ~left:(Js.Null.fromOption l) + ~right:(Js.Null.fromOption r) + + +let test1 = + n 1 + ~l: + (n 2 + ~l:(n 4 ) + ~r:(n 5)) + ~r:(n 3) + +let pushAllLeft st1 s1 = + let current = ref st1 in + while !current != Js.null do + let v = Js.Null.castUnsafe !current in + S.push s1 v; + current := left v; + done +;; + + +let test2 = + n 3 + ~l:( + n 1 + ~l:( + n 5 + ~l: + (n 2 + ~l: + (n 4) + ) + ) + ) + +let test3 = + + n 1 + ~l:( + n 5 + ~l: + (n 2 + ~l: + (n 4) + ) + ) + ~r:(n 3) + +let () = + Js.log (inOrder (Js.Null.return test1)); + Js.log (inOrder3 (Js.Null.return test1)) diff --git a/jscomp/test/ffi_test.js b/jscomp/test/ffi_test.js index d271747b2a..445c3e4cb5 100644 --- a/jscomp/test/ffi_test.js +++ b/jscomp/test/ffi_test.js @@ -9,8 +9,6 @@ var a = true; var b = false; -var c = null; - var d = undefined; var Textarea = /* module */[]; @@ -29,6 +27,8 @@ function f() { return v[0]; } +var c = null; + exports.u = u; exports.a = a; exports.b = b; @@ -38,4 +38,4 @@ exports.Textarea = Textarea; exports.Int32Array = Int32Array; exports.v = v; exports.f = f; -/* Not a pure module */ +/* a Not a pure module */ diff --git a/jscomp/test/gpr_1245_test.ml b/jscomp/test/gpr_1245_test.ml index 6b3b20b388..6d7e2f799b 100644 --- a/jscomp/test/gpr_1245_test.ml +++ b/jscomp/test/gpr_1245_test.ml @@ -17,7 +17,7 @@ let f (c,d) = such block. It is more general than - [Js.Null.to_opt] + [Js.Null.toOption] since its box number is one and immutable, so we can give it a meaningful name for such slot @@ -34,7 +34,7 @@ let g () = let a0 f = - let u = Js.Null.to_opt (f ()) in + let u = Js.Null.toOption (f ()) in match u with | None -> 0 | Some x -> Js.log x ; Js.log x ; 1 diff --git a/jscomp/test/gpr_974_test.ml b/jscomp/test/gpr_974_test.ml index c1e6e57a52..d0b46661f0 100644 --- a/jscomp/test/gpr_974_test.ml +++ b/jscomp/test/gpr_974_test.ml @@ -4,5 +4,5 @@ let _ = begin assert (Js.Null_undefined.to_opt (Js.Null_undefined.return "" ) = Some ""); assert (Js.Undefined.to_opt (Js.Undefined.return "" ) = Some ""); - assert (Js.Null.to_opt (Js.Null.return "") = Some "") + assert (Js.Null.toOption (Js.Null.return "") = Some "") end diff --git a/jscomp/test/js_null_test.js b/jscomp/test/js_null_test.js index b20e7f8284..0c89328977 100644 --- a/jscomp/test/js_null_test.js +++ b/jscomp/test/js_null_test.js @@ -115,7 +115,7 @@ var suites_001 = /* :: */[ (function () { return /* Eq */Block.__(0, [ null, - Js_null.from_opt(/* None */0) + Js_null.fromOption(/* None */0) ]); }) ], @@ -125,7 +125,7 @@ var suites_001 = /* :: */[ (function () { return /* Eq */Block.__(0, [ 2, - Js_null.from_opt(/* Some */[2]) + Js_null.fromOption(/* Some */[2]) ]); }) ], diff --git a/jscomp/test/js_null_test.ml b/jscomp/test/js_null_test.ml index 386ff01aa9..cd21377306 100644 --- a/jscomp/test/js_null_test.ml +++ b/jscomp/test/js_null_test.ml @@ -1,9 +1,9 @@ open Js_null let suites = Mt.[ - "to_opt - empty", (fun _ -> Eq(None, empty |> to_opt)); - "to_opt - 'a", (fun _ -> Eq(Some (), return () |> to_opt)); - "return", (fun _ -> Eq(Some "something", return "something" |> to_opt)); + "to_opt - empty", (fun _ -> Eq(None, empty |> toOption)); + "to_opt - 'a", (fun _ -> Eq(Some (), return () |> toOption)); + "return", (fun _ -> Eq(Some "something", return "something" |> toOption)); "test - empty", (fun _ -> Eq(true, empty |> test)); "test - 'a", (fun _ -> Eq(false, return () |> test)); "bind - empty", (fun _ -> StrictEq(empty, bind empty ((fun v -> v) [@bs]))); @@ -18,7 +18,7 @@ let suites = Mt.[ let _ = iter (return 2) ((fun v -> hit := v) [@bs]) in Eq(2, !hit) ); - "from_opt - None", (fun _ -> Eq(empty, None |> from_opt)); - "from_opt - Some", (fun _ -> Eq(return 2, Some 2 |> from_opt)); + "from_opt - None", (fun _ -> Eq(empty, None |> fromOption)); + "from_opt - Some", (fun _ -> Eq(return 2, Some 2 |> fromOption)); ] ;; Mt.from_pair_suites __FILE__ suites diff --git a/jscomp/test/test_zero_nullable.ml b/jscomp/test/test_zero_nullable.ml index 0f752d7549..63c71bf8e9 100644 --- a/jscomp/test/test_zero_nullable.ml +++ b/jscomp/test/test_zero_nullable.ml @@ -8,7 +8,7 @@ let eq loc x y = module Test_null = struct let f1 x = - match Js.Null.to_opt x with + match Js.Null.toOption x with | None -> let sum x y = x + y in sum 1 2 @@ -17,7 +17,7 @@ let f1 x = sum x 1 let f2 x = - let u = Js.Null.to_opt x in + let u = Js.Null.toOption x in match u with | None -> let sum x y = x + y in @@ -29,7 +29,7 @@ let f2 x = let f5 h x = - let u = Js.Null.to_opt @@ h 32 in + let u = Js.Null.toOption @@ h 32 in match u with | None -> let sum x y = x + y in @@ -39,7 +39,7 @@ let f5 h x = sum x 1 let f4 h x = - let u = Js.Null.to_opt @@ h 32 in + let u = Js.Null.toOption @@ h 32 in let v = 32 + x in match u with | None -> @@ -60,16 +60,16 @@ let f7 x = No, if [x] is [null] then None else [Some x] *) let f8 (x : 'a Js.Null.t Js.Null.t)= - match Js.Null.to_opt x with + match Js.Null.toOption x with | Some x -> - (match Js.Null.to_opt x with + (match Js.Null.toOption x with | Some _ -> 0 | None -> 1 ) | None -> 2 let u = f8 (Js.Null.return (Js.Null.return None)) -let f9 x = Js.Null.to_opt x +let f9 x = Js.Null.toOption x let f10 x = Js.Null.test x diff --git a/lib/js/bs.js b/lib/js/bs.js index 3bc1e3a2e5..05dcb3d5a9 100644 --- a/lib/js/bs.js +++ b/lib/js/bs.js @@ -29,6 +29,8 @@ var HashMapInt = 0; var Sort = 0; +var Stack = 0; + var Range = 0; var $$Map = 0; @@ -63,6 +65,7 @@ exports.HashMapString = HashMapString; exports.HashMultiMap = HashMultiMap; exports.HashMapInt = HashMapInt; exports.Sort = Sort; +exports.Stack = Stack; exports.Range = Range; exports.$$Map = $$Map; exports.$$Set = $$Set; diff --git a/lib/js/bs_Map.js b/lib/js/bs_Map.js index 97924ae934..c3397cff4f 100644 --- a/lib/js/bs_Map.js +++ b/lib/js/bs_Map.js @@ -221,66 +221,82 @@ function merge0(cmp, f, s1, s2) { } -function compare0(keycmp, cmp, m1, m2) { - var _e1 = Bs_internalAVLtree.cons_enum(m1, /* End */0); - var _e2 = Bs_internalAVLtree.cons_enum(m2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - var c = keycmp(e1[0], e2[0]); - if (c !== 0) { - return c; - } else { - var c$1 = cmp(e1[1], e2[1]); - if (c$1 !== 0) { - return c$1; +function cmp0(s1, s2, kcmp, vcmp) { + var len1 = Bs_internalAVLtree.length0(s1); + var len2 = Bs_internalAVLtree.length0(s2); + if (len1 === len2) { + var _e1 = Bs_internalAVLtree.stackAllLeft(s1, /* [] */0); + var _e2 = Bs_internalAVLtree.stackAllLeft(s2, /* [] */0); + var kcmp$1 = kcmp; + var vcmp$1 = vcmp; + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var h2 = e2[0]; + var h1 = e1[0]; + var c = kcmp$1(h1.key, h2.key); + if (c) { + return c; } else { - _e2 = Bs_internalAVLtree.cons_enum(e2[2], e2[3]); - _e1 = Bs_internalAVLtree.cons_enum(e1[2], e1[3]); - continue ; - + var cx = vcmp$1(h1.value, h2.value); + if (cx) { + return cx; + } else { + _e2 = Bs_internalAVLtree.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLtree.stackAllLeft(h1.right, e1[1]); + continue ; + + } } + } else { + return 0; } } else { - return 1; + return 0; } - } else if (e2) { - return -1; - } else { - return 0; - } - }; + }; + } else if (len1 < len2) { + return -1; + } else { + return 1; + } } -function equal0(keycmp, cmp, m1, m2) { - var _e1 = Bs_internalAVLtree.cons_enum(m1, /* End */0); - var _e2 = Bs_internalAVLtree.cons_enum(m2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (keycmp(e1[0], e2[0])) { - return /* false */0; - } else if (cmp(e1[1], e2[1])) { - _e2 = Bs_internalAVLtree.cons_enum(e2[2], e2[3]); - _e1 = Bs_internalAVLtree.cons_enum(e1[2], e1[3]); - continue ; - +function eq0(s1, s2, kcmp, vcmp) { + var len1 = Bs_internalAVLtree.length0(s1); + var len2 = Bs_internalAVLtree.length0(s2); + if (len1 === len2) { + var _e1 = Bs_internalAVLtree.stackAllLeft(s1, /* [] */0); + var _e2 = Bs_internalAVLtree.stackAllLeft(s2, /* [] */0); + var kcmp$1 = kcmp; + var vcmp$1 = vcmp; + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var h2 = e2[0]; + var h1 = e1[0]; + if (kcmp$1(h1.key, h2.key) === 0 && vcmp$1(h1.value, h2.value)) { + _e2 = Bs_internalAVLtree.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLtree.stackAllLeft(h1.right, e1[1]); + continue ; + + } else { + return /* false */0; + } } else { - return /* false */0; + return /* true */1; } } else { - return /* false */0; + return /* true */1; } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; + }; + } else { + return /* false */0; + } } function ofArray0(cmp, xs) { @@ -351,8 +367,8 @@ function partition(p, map) { ]; } -function cardinal(map) { - return Bs_internalAVLtree.cardinal0(map.data); +function length(map) { + return Bs_internalAVLtree.length0(map.data); } function bindings(map) { @@ -461,18 +477,18 @@ function merge(f, s1, s2) { }; } -function compare(cmp, m1, m2) { +function cmp(m1, m2, cmp$1) { var dict = m1.dict; var m1_data = m1.data; var m2_data = m2.data; - return compare0(dict[/* cmp */0], cmp, m1_data, m2_data); + return cmp0(m1_data, m2_data, dict[/* cmp */0], cmp$1); } -function equal(cmp, m1, m2) { +function eq(m1, m2, cmp) { var dict = m1.dict; var m1_data = m1.data; var m2_data = m2.data; - return equal0(dict[/* cmp */0], cmp, m1_data, m2_data); + return eq0(m1_data, m2_data, dict[/* cmp */0], cmp); } var empty0 = Bs_internalAVLtree.empty0; @@ -493,7 +509,7 @@ var filter0 = Bs_internalAVLtree.filter0; var partition0 = Bs_internalAVLtree.partition0; -var cardinal0 = Bs_internalAVLtree.cardinal0; +var length0 = Bs_internalAVLtree.length0; var bindings0 = Bs_internalAVLtree.bindings0; @@ -521,10 +537,10 @@ exports.remove0 = remove0; exports.remove = remove; exports.merge0 = merge0; exports.merge = merge; -exports.compare0 = compare0; -exports.compare = compare; -exports.equal0 = equal0; -exports.equal = equal; +exports.cmp0 = cmp0; +exports.cmp = cmp; +exports.eq0 = eq0; +exports.eq = eq; exports.iter0 = iter0; exports.iter = iter; exports.fold0 = fold0; @@ -537,8 +553,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.bindings0 = bindings0; exports.bindings = bindings; exports.minBinding0 = minBinding0; diff --git a/lib/js/bs_MapInt.js b/lib/js/bs_MapInt.js index e2696ab9f9..de6f232bf7 100644 --- a/lib/js/bs_MapInt.js +++ b/lib/js/bs_MapInt.js @@ -1,5 +1,6 @@ 'use strict'; +var Caml_primitive = require("./caml_primitive.js"); var Bs_internalAVLtree = require("./bs_internalAVLtree.js"); function add(x, data, t) { @@ -208,73 +209,80 @@ function merge(f, s1, s2) { } -function compare(cmp, m1, m2) { - var _e1 = Bs_internalAVLtree.cons_enum(m1, /* End */0); - var _e2 = Bs_internalAVLtree.cons_enum(m2, /* 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 { - var c = cmp(e1[1], e2[1]); - if (c !== 0) { +function cmp(s1, s2, cmp$1) { + var len1 = Bs_internalAVLtree.length0(s1); + var len2 = Bs_internalAVLtree.length0(s2); + if (len1 === len2) { + var _e1 = Bs_internalAVLtree.stackAllLeft(s1, /* [] */0); + var _e2 = Bs_internalAVLtree.stackAllLeft(s2, /* [] */0); + var vcmp = cmp$1; + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var h2 = e2[0]; + var h1 = e1[0]; + var c = Caml_primitive.caml_int_compare(h1.key, h2.key); + if (c) { return c; } else { - _e2 = Bs_internalAVLtree.cons_enum(e2[2], e2[3]); - _e1 = Bs_internalAVLtree.cons_enum(e1[2], e1[3]); - continue ; - + var cx = vcmp(h1.value, h2.value); + if (cx) { + return cx; + } else { + _e2 = Bs_internalAVLtree.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLtree.stackAllLeft(h1.right, e1[1]); + continue ; + + } } + } else { + return 0; } } else { - return 1; + return 0; } - } else if (e2) { - return -1; - } else { - return 0; - } - }; + }; + } else if (len1 < len2) { + return -1; + } else { + return 1; + } } -function equal(cmp, m1, m2) { - var _e1 = Bs_internalAVLtree.cons_enum(m1, /* End */0); - var _e2 = Bs_internalAVLtree.cons_enum(m2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (e1[0] === e2[0]) { - if (cmp(e1[1], e2[1])) { - _e2 = Bs_internalAVLtree.cons_enum(e2[2], e2[3]); - _e1 = Bs_internalAVLtree.cons_enum(e1[2], e1[3]); +function eq(s1, s2, eq$1) { + var len1 = Bs_internalAVLtree.length0(s1); + var len2 = Bs_internalAVLtree.length0(s2); + if (len1 === len2) { + var _e1 = Bs_internalAVLtree.stackAllLeft(s1, /* [] */0); + var _e2 = Bs_internalAVLtree.stackAllLeft(s2, /* [] */0); + var eq$2 = eq$1; + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var h2 = e2[0]; + var h1 = e1[0]; + if (h1.key === h2.key && eq$2(h1.value, h2.value)) { + _e2 = Bs_internalAVLtree.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLtree.stackAllLeft(h1.right, e1[1]); continue ; } else { return /* false */0; } } else { - return /* false */0; + return /* true */1; } } else { - return /* false */0; + return /* true */1; } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; + }; + } else { + return /* false */0; + } } function ofArray(xs) { @@ -304,7 +312,7 @@ var filter = Bs_internalAVLtree.filter0; var partition = Bs_internalAVLtree.partition0; -var cardinal = Bs_internalAVLtree.cardinal0; +var length = Bs_internalAVLtree.length0; var bindings = Bs_internalAVLtree.bindings0; @@ -326,15 +334,15 @@ exports.add = add; exports.singleton = singleton; exports.remove = remove; exports.merge = merge; -exports.compare = compare; -exports.equal = equal; +exports.cmp = cmp; +exports.eq = eq; exports.iter = iter; exports.fold = fold; exports.forAll = forAll; exports.exists = exists; exports.filter = filter; exports.partition = partition; -exports.cardinal = cardinal; +exports.length = length; exports.bindings = bindings; exports.minBinding = minBinding; exports.maxBinding = maxBinding; diff --git a/lib/js/bs_MapString.js b/lib/js/bs_MapString.js index e2696ab9f9..7d01a4f76d 100644 --- a/lib/js/bs_MapString.js +++ b/lib/js/bs_MapString.js @@ -1,5 +1,6 @@ 'use strict'; +var Caml_primitive = require("./caml_primitive.js"); var Bs_internalAVLtree = require("./bs_internalAVLtree.js"); function add(x, data, t) { @@ -208,73 +209,80 @@ function merge(f, s1, s2) { } -function compare(cmp, m1, m2) { - var _e1 = Bs_internalAVLtree.cons_enum(m1, /* End */0); - var _e2 = Bs_internalAVLtree.cons_enum(m2, /* 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 { - var c = cmp(e1[1], e2[1]); - if (c !== 0) { +function cmp(s1, s2, cmp$1) { + var len1 = Bs_internalAVLtree.length0(s1); + var len2 = Bs_internalAVLtree.length0(s2); + if (len1 === len2) { + var _e1 = Bs_internalAVLtree.stackAllLeft(s1, /* [] */0); + var _e2 = Bs_internalAVLtree.stackAllLeft(s2, /* [] */0); + var vcmp = cmp$1; + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var h2 = e2[0]; + var h1 = e1[0]; + var c = Caml_primitive.caml_string_compare(h1.key, h2.key); + if (c) { return c; } else { - _e2 = Bs_internalAVLtree.cons_enum(e2[2], e2[3]); - _e1 = Bs_internalAVLtree.cons_enum(e1[2], e1[3]); - continue ; - + var cx = vcmp(h1.value, h2.value); + if (cx) { + return cx; + } else { + _e2 = Bs_internalAVLtree.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLtree.stackAllLeft(h1.right, e1[1]); + continue ; + + } } + } else { + return 0; } } else { - return 1; + return 0; } - } else if (e2) { - return -1; - } else { - return 0; - } - }; + }; + } else if (len1 < len2) { + return -1; + } else { + return 1; + } } -function equal(cmp, m1, m2) { - var _e1 = Bs_internalAVLtree.cons_enum(m1, /* End */0); - var _e2 = Bs_internalAVLtree.cons_enum(m2, /* End */0); - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (e1[0] === e2[0]) { - if (cmp(e1[1], e2[1])) { - _e2 = Bs_internalAVLtree.cons_enum(e2[2], e2[3]); - _e1 = Bs_internalAVLtree.cons_enum(e1[2], e1[3]); +function eq(s1, s2, eq$1) { + var len1 = Bs_internalAVLtree.length0(s1); + var len2 = Bs_internalAVLtree.length0(s2); + if (len1 === len2) { + var _e1 = Bs_internalAVLtree.stackAllLeft(s1, /* [] */0); + var _e2 = Bs_internalAVLtree.stackAllLeft(s2, /* [] */0); + var eq$2 = eq$1; + while(true) { + var e2 = _e2; + var e1 = _e1; + if (e1) { + if (e2) { + var h2 = e2[0]; + var h1 = e1[0]; + if (h1.key === h2.key && eq$2(h1.value, h2.value)) { + _e2 = Bs_internalAVLtree.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLtree.stackAllLeft(h1.right, e1[1]); continue ; } else { return /* false */0; } } else { - return /* false */0; + return /* true */1; } } else { - return /* false */0; + return /* true */1; } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; + }; + } else { + return /* false */0; + } } function ofArray(xs) { @@ -304,7 +312,7 @@ var filter = Bs_internalAVLtree.filter0; var partition = Bs_internalAVLtree.partition0; -var cardinal = Bs_internalAVLtree.cardinal0; +var length = Bs_internalAVLtree.length0; var bindings = Bs_internalAVLtree.bindings0; @@ -326,15 +334,15 @@ exports.add = add; exports.singleton = singleton; exports.remove = remove; exports.merge = merge; -exports.compare = compare; -exports.equal = equal; +exports.cmp = cmp; +exports.eq = eq; exports.iter = iter; exports.fold = fold; exports.forAll = forAll; exports.exists = exists; exports.filter = filter; exports.partition = partition; -exports.cardinal = cardinal; +exports.length = length; exports.bindings = bindings; exports.minBinding = minBinding; exports.maxBinding = maxBinding; diff --git a/lib/js/bs_Queue.js b/lib/js/bs_Queue.js index 4215d8ccec..1a489d14d3 100644 --- a/lib/js/bs_Queue.js +++ b/lib/js/bs_Queue.js @@ -18,7 +18,7 @@ function clear(q) { return /* () */0; } -function push(x, q) { +function push(q, x) { var cell = { content: x, next: $$null @@ -156,7 +156,7 @@ function length(q) { return q.length; } -function iter(f, q) { +function iter(q, f) { var f$1 = f; var _cell = q.first; while(true) { @@ -172,7 +172,7 @@ function iter(f, q) { }; } -function fold(f, accu, q) { +function fold(q, accu, f) { var f$1 = f; var _accu = accu; var _cell = q.first; diff --git a/lib/js/bs_Set.js b/lib/js/bs_Set.js index 78dd3d2992..c90981a5ce 100644 --- a/lib/js/bs_Set.js +++ b/lib/js/bs_Set.js @@ -124,7 +124,7 @@ function cmp(m, n) { var dict = m.dict; var mdata = m.data; var ndata = n.data; - return Bs_internalSet.cmp0(dict[/* cmp */0], mdata, ndata); + return Bs_internalSet.cmp0(mdata, ndata, dict[/* cmp */0]); } function eq(m, n) { diff --git a/lib/js/bs_SetM.js b/lib/js/bs_SetM.js index 701ed5b5e3..86f4f7e6ad 100644 --- a/lib/js/bs_SetM.js +++ b/lib/js/bs_SetM.js @@ -197,7 +197,7 @@ function remove(d, v) { function cmp(d0, d1) { var dict = d0.dict; - return Bs_internalSet.cmp0(dict[/* cmp */0], d0.data, d1.data); + return Bs_internalSet.cmp0(d0.data, d1.data, dict[/* cmp */0]); } function diff(d0, d1) { diff --git a/lib/js/bs_Stack.js b/lib/js/bs_Stack.js new file mode 100644 index 0000000000..4ea8dcc1d9 --- /dev/null +++ b/lib/js/bs_Stack.js @@ -0,0 +1,133 @@ +'use strict'; + + +function create() { + return { + root: null + }; +} + +function clear(s) { + s.root = null; + return /* () */0; +} + +function copy(s) { + return { + root: s.root + }; +} + +function push(s, x) { + s.root = { + head: x, + tail: s.root + }; + return /* () */0; +} + +function topNull(s) { + var match = s.root; + if (match !== null) { + return match.head; + } else { + return null; + } +} + +function topOpt(s) { + var match = s.root; + if (match !== null) { + return /* Some */[match.head]; + } else { + return /* None */0; + } +} + +function isEmpty(s) { + return +(s.root === null); +} + +function popNull(s) { + var match = s.root; + if (match !== null) { + s.root = match.tail; + return match.head; + } else { + return null; + } +} + +function popOpt(s) { + var match = s.root; + if (match !== null) { + s.root = match.tail; + return /* Some */[match.head]; + } else { + return /* None */0; + } +} + +function length(s) { + var match = s.root; + if (match !== null) { + var _x = match; + var _acc = 0; + while(true) { + var acc = _acc; + var x = _x; + var match$1 = x.tail; + if (match$1 !== null) { + _acc = acc + 1 | 0; + _x = match$1; + continue ; + + } else { + return acc + 1 | 0; + } + }; + } else { + return 0; + } +} + +function iter(s, f) { + var _s = s.root; + var f$1 = f; + while(true) { + var s$1 = _s; + if (s$1 !== null) { + f$1(s$1.head); + _s = s$1.tail; + continue ; + + } else { + return /* () */0; + } + }; +} + +function dynamicPopIter(s, f) { + var cursor = s.root; + while(cursor !== null) { + var v = cursor; + s.root = v.tail; + f(v.head); + cursor = s.root; + }; + return /* () */0; +} + +exports.create = create; +exports.clear = clear; +exports.copy = copy; +exports.push = push; +exports.popNull = popNull; +exports.popOpt = popOpt; +exports.topNull = topNull; +exports.topOpt = topOpt; +exports.isEmpty = isEmpty; +exports.length = length; +exports.iter = iter; +exports.dynamicPopIter = dynamicPopIter; +/* No side effect */ diff --git a/lib/js/bs_internalAVLset.js b/lib/js/bs_internalAVLset.js index 1f8610b4f2..73d53d29cf 100644 --- a/lib/js/bs_internalAVLset.js +++ b/lib/js/bs_internalAVLset.js @@ -190,21 +190,20 @@ function isEmpty0(n) { } } -function toEnum(_s, _e) { +function stackAllLeft(_v, _s) { while(true) { - var e = _e; var s = _s; - if (s !== null) { - _e = /* More */[ - s.key, - s.right, - e + var v = _v; + if (v !== null) { + _s = /* :: */[ + v, + s ]; - _s = s.left; + _v = v.left; continue ; } else { - return e; + return s; } }; } @@ -365,17 +364,17 @@ function partition0(n, p) { } } -function cardinalAux(n) { +function lengthAux(n) { var l = n.left; var r = n.right; - var sizeL = l !== null ? cardinalAux(l) : 0; - var sizeR = r !== null ? cardinalAux(r) : 0; + var sizeL = l !== null ? lengthAux(l) : 0; + var sizeR = r !== null ? lengthAux(r) : 0; return (1 + sizeL | 0) + sizeR | 0; } function length0(n) { if (n !== null) { - return cardinalAux(n); + return lengthAux(n); } else { return 0; } @@ -457,7 +456,7 @@ function fillArray(_n, _i, arr) { function toArray0(n) { if (n !== null) { - var size = cardinalAux(n); + var size = lengthAux(n); var v = new Array(size); fillArray(n, 0, v); return v; @@ -623,7 +622,7 @@ exports.maxNull0 = maxNull0; exports.removeMinAuxWithRef = removeMinAuxWithRef; exports.empty0 = empty0; exports.isEmpty0 = isEmpty0; -exports.toEnum = toEnum; +exports.stackAllLeft = stackAllLeft; exports.iter0 = iter0; exports.fold0 = fold0; exports.forAll0 = forAll0; @@ -632,7 +631,7 @@ exports.join = join; exports.concat = concat; exports.filter0 = filter0; exports.partition0 = partition0; -exports.cardinalAux = cardinalAux; +exports.lengthAux = lengthAux; exports.length0 = length0; exports.toListAux = toListAux; exports.toList0 = toList0; diff --git a/lib/js/bs_internalAVLtree.js b/lib/js/bs_internalAVLtree.js index 5cf1002ad5..b1a9cad3ae 100644 --- a/lib/js/bs_internalAVLtree.js +++ b/lib/js/bs_internalAVLtree.js @@ -420,41 +420,35 @@ function partition0(p, n) { } } -function cons_enum(_m, _e) { +function stackAllLeft(_v, _s) { while(true) { - var e = _e; - var m = _m; - if (m !== null) { - var l = m.left; - var v = m.key; - var d = m.value; - var r = m.right; - _e = /* More */[ + var s = _s; + var v = _v; + if (v !== null) { + _s = /* :: */[ v, - d, - r, - e + s ]; - _m = l; + _v = v.left; continue ; } else { - return e; + return s; } }; } -function cardinalAux(n) { +function lengthAux(n) { var l = n.left; var r = n.right; - var sizeL = l !== null ? cardinalAux(l) : 0; - var sizeR = r !== null ? cardinalAux(r) : 0; + var sizeL = l !== null ? lengthAux(l) : 0; + var sizeR = r !== null ? lengthAux(r) : 0; return (1 + sizeL | 0) + sizeR | 0; } -function cardinal0(n) { +function length0(n) { if (n !== null) { - return cardinalAux(n); + return lengthAux(n); } else { return 0; } @@ -544,9 +538,9 @@ exports.concat = concat; exports.concat_or_join = concat_or_join; exports.filter0 = filter0; exports.partition0 = partition0; -exports.cons_enum = cons_enum; -exports.cardinalAux = cardinalAux; -exports.cardinal0 = cardinal0; +exports.stackAllLeft = stackAllLeft; +exports.lengthAux = lengthAux; +exports.length0 = length0; exports.bindings_aux = bindings_aux; exports.bindings0 = bindings0; exports.checkInvariant = checkInvariant; diff --git a/lib/js/bs_internalSet.js b/lib/js/bs_internalSet.js index 67531efc60..4170cb9dfe 100644 --- a/lib/js/bs_internalSet.js +++ b/lib/js/bs_internalSet.js @@ -114,38 +114,46 @@ function removeArray0(h, arr, cmp) { return v; } -function compareAux(cmp, _e1, _e2) { +function compareAux(_e1, _e2, cmp) { while(true) { var e2 = _e2; var e1 = _e1; if (e1) { if (e2) { - var c = cmp(e1[0], e2[0]); - if (c !== 0) { + var h2 = e2[0]; + var h1 = e1[0]; + var c = cmp(h1.key, h2.key); + if (c) { return c; } else { - _e2 = Bs_internalAVLset.toEnum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.toEnum(e1[1], e1[2]); + _e2 = Bs_internalAVLset.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLset.stackAllLeft(h1.right, e1[1]); continue ; } } else { - return 1; + return 0; } - } else if (e2) { - return -1; } else { return 0; } }; } -function cmp0(cmp, s1, s2) { - return compareAux(cmp, Bs_internalAVLset.toEnum(s1, /* End */0), Bs_internalAVLset.toEnum(s2, /* End */0)); +function cmp0(s1, s2, cmp) { + var len1 = Bs_internalAVLset.length0(s1); + var len2 = Bs_internalAVLset.length0(s2); + if (len1 === len2) { + return compareAux(Bs_internalAVLset.stackAllLeft(s1, /* [] */0), Bs_internalAVLset.stackAllLeft(s2, /* [] */0), cmp); + } else if (len1 < len2) { + return -1; + } else { + return 1; + } } function eq0(cmp, s1, s2) { - return +(cmp0(cmp, s1, s2) === 0); + return +(cmp0(s1, s2, cmp) === 0); } function splitAuxNoPivot(cmp, n, x) { diff --git a/lib/js/bs_internalSetInt.js b/lib/js/bs_internalSetInt.js index 673ccfbb40..5f0b065c96 100644 --- a/lib/js/bs_internalSetInt.js +++ b/lib/js/bs_internalSetInt.js @@ -91,31 +91,29 @@ function remove(t, x) { } } -function compare_aux(_e1, _e2) { +function compareAux(_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.toEnum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.toEnum(e1[1], e1[2]); + var h2 = e2[0]; + var h1 = e1[0]; + var k1 = h1.key; + var k2 = h2.key; + if (k1 === k2) { + _e2 = Bs_internalAVLset.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLset.stackAllLeft(h1.right, e1[1]); continue ; + } else if (k1 < k2) { + return -1; + } else { + return 1; } } else { - return 1; + return 0; } - } else if (e2) { - return -1; } else { return 0; } @@ -123,36 +121,19 @@ function compare_aux(_e1, _e2) { } function cmp(s1, s2) { - return compare_aux(Bs_internalAVLset.toEnum(s1, /* End */0), Bs_internalAVLset.toEnum(s2, /* End */0)); -} - -function eqAux(_e1, _e2) { - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (e1[0] === e2[0]) { - _e2 = Bs_internalAVLset.toEnum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.toEnum(e1[1], e1[2]); - continue ; - - } else { - return /* false */0; - } - } else { - return /* false */0; - } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; + var len1 = Bs_internalAVLset.length0(s1); + var len2 = Bs_internalAVLset.length0(s2); + if (len1 === len2) { + return compareAux(Bs_internalAVLset.stackAllLeft(s1, /* [] */0), Bs_internalAVLset.stackAllLeft(s2, /* [] */0)); + } else if (len1 < len2) { + return -1; + } else { + return 1; + } } function eq(s1, s2) { - return eqAux(Bs_internalAVLset.toEnum(s1, /* End */0), Bs_internalAVLset.toEnum(s2, /* End */0)); + return +(cmp(s1, s2) === 0); } function splitAuxNoPivot(n, x) { @@ -397,24 +378,6 @@ function findOpt(_n, x) { }; } -function findAssert(_n, x) { - 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 findNull(_n, x) { while(true) { var n = _n; @@ -553,9 +516,8 @@ exports.A = A; exports.add = add; exports.mem = mem; exports.remove = remove; -exports.compare_aux = compare_aux; +exports.compareAux = compareAux; exports.cmp = cmp; -exports.eqAux = eqAux; exports.eq = eq; exports.splitAuxNoPivot = splitAuxNoPivot; exports.splitAuxPivot = splitAuxPivot; @@ -565,7 +527,6 @@ exports.inter = inter; exports.diff = diff; exports.subset = subset; exports.findOpt = findOpt; -exports.findAssert = findAssert; exports.findNull = findNull; exports.addMutate = addMutate; exports.removeMutateAux = removeMutateAux; diff --git a/lib/js/bs_internalSetString.js b/lib/js/bs_internalSetString.js index 673ccfbb40..5f0b065c96 100644 --- a/lib/js/bs_internalSetString.js +++ b/lib/js/bs_internalSetString.js @@ -91,31 +91,29 @@ function remove(t, x) { } } -function compare_aux(_e1, _e2) { +function compareAux(_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.toEnum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.toEnum(e1[1], e1[2]); + var h2 = e2[0]; + var h1 = e1[0]; + var k1 = h1.key; + var k2 = h2.key; + if (k1 === k2) { + _e2 = Bs_internalAVLset.stackAllLeft(h2.right, e2[1]); + _e1 = Bs_internalAVLset.stackAllLeft(h1.right, e1[1]); continue ; + } else if (k1 < k2) { + return -1; + } else { + return 1; } } else { - return 1; + return 0; } - } else if (e2) { - return -1; } else { return 0; } @@ -123,36 +121,19 @@ function compare_aux(_e1, _e2) { } function cmp(s1, s2) { - return compare_aux(Bs_internalAVLset.toEnum(s1, /* End */0), Bs_internalAVLset.toEnum(s2, /* End */0)); -} - -function eqAux(_e1, _e2) { - while(true) { - var e2 = _e2; - var e1 = _e1; - if (e1) { - if (e2) { - if (e1[0] === e2[0]) { - _e2 = Bs_internalAVLset.toEnum(e2[1], e2[2]); - _e1 = Bs_internalAVLset.toEnum(e1[1], e1[2]); - continue ; - - } else { - return /* false */0; - } - } else { - return /* false */0; - } - } else if (e2) { - return /* false */0; - } else { - return /* true */1; - } - }; + var len1 = Bs_internalAVLset.length0(s1); + var len2 = Bs_internalAVLset.length0(s2); + if (len1 === len2) { + return compareAux(Bs_internalAVLset.stackAllLeft(s1, /* [] */0), Bs_internalAVLset.stackAllLeft(s2, /* [] */0)); + } else if (len1 < len2) { + return -1; + } else { + return 1; + } } function eq(s1, s2) { - return eqAux(Bs_internalAVLset.toEnum(s1, /* End */0), Bs_internalAVLset.toEnum(s2, /* End */0)); + return +(cmp(s1, s2) === 0); } function splitAuxNoPivot(n, x) { @@ -397,24 +378,6 @@ function findOpt(_n, x) { }; } -function findAssert(_n, x) { - 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 findNull(_n, x) { while(true) { var n = _n; @@ -553,9 +516,8 @@ exports.A = A; exports.add = add; exports.mem = mem; exports.remove = remove; -exports.compare_aux = compare_aux; +exports.compareAux = compareAux; exports.cmp = cmp; -exports.eqAux = eqAux; exports.eq = eq; exports.splitAuxNoPivot = splitAuxNoPivot; exports.splitAuxPivot = splitAuxPivot; @@ -565,7 +527,6 @@ exports.inter = inter; exports.diff = diff; exports.subset = subset; exports.findOpt = findOpt; -exports.findAssert = findAssert; exports.findNull = findNull; exports.addMutate = addMutate; exports.removeMutateAux = removeMutateAux; diff --git a/lib/js/caml_int64.js b/lib/js/caml_int64.js index ce2f16e04d..84f3027bb1 100644 --- a/lib/js/caml_int64.js +++ b/lib/js/caml_int64.js @@ -11,7 +11,7 @@ var min_int = /* record */[ ]; var max_int = /* record */[ - /* hi */134217727, + /* hi */2147483647, /* lo */1 ]; diff --git a/lib/js/js_null.js b/lib/js/js_null.js index 16a15d5614..6aedc0e578 100644 --- a/lib/js/js_null.js +++ b/lib/js/js_null.js @@ -1,6 +1,14 @@ 'use strict'; +function castExn(f) { + if (f !== null) { + return f; + } else { + throw new Error("null"); + } +} + function bind(x, f) { if (x !== null) { return f(x); @@ -17,7 +25,7 @@ function iter(x, f) { } } -function from_opt(x) { +function fromOption(x) { if (x) { return x[0]; } else { @@ -25,7 +33,11 @@ function from_opt(x) { } } +var from_opt = fromOption; + +exports.castExn = castExn; exports.bind = bind; exports.iter = iter; +exports.fromOption = fromOption; exports.from_opt = from_opt; /* No side effect */