Merge pull request #2432 from BuckleScript/add_bs_stack

add stack
rescript-lang · Jan 7, 2018 · d386cc9 · d386cc9
2 parents 1efb31c + 9c49bf7
commit d386cc9
Show file tree

Hide file tree

Showing 57 changed files with 1,425 additions and 852 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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,26 +239,26 @@ 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) = 
   let dict,map = B.(dict map, data map) in 
   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,23 +298,26 @@ 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) = 
   let dict, s1_data, s2_data = B.(dict s1, data s1, data s2) in 
   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 
+  eq0 ~kcmp:X.cmp ~vcmp:cmp m1_data m2_data 
diff --git 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
@@ -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
@@ -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
  *)