Merge 09d6eeb into 1efb31c

jscomp/others/.depend

@@ -17,7 +17,7 @@ js_console.cmj :
 js_result.cmj : js_result.cmi
 js_mapperRt.cmj : js_mapperRt.cmi
 bs_Array.cmj : js_math.cmj bs_Array.cmi
-bs_internalAVLset.cmj : bs_Array.cmj bs.cmj
+bs_internalAVLset.cmj : bs_Stack.cmj bs_Array.cmj bs.cmj
 bs_internalAVLtree.cmj :
 bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetIntM.cmi
 bs_Hash.cmj : bs_Hash.cmi
@@ -45,20 +45,21 @@ bs_Map.cmj : bs_internalAVLtree.cmj bs_Cmp.cmj bs_Bag.cmj bs_Array.cmj \
     bs_Map.cmi
 bs_MapString.cmj : bs_internalAVLtree.cmj bs_Array.cmj bs_MapString.cmi
 bs_MapInt.cmj : bs_internalAVLtree.cmj bs_Array.cmj bs_MapInt.cmi
-bs_internalSet.cmj : bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj \
-    bs_Array.cmj
+bs_internalSet.cmj : bs_internalAVLset.cmj bs_Stack.cmj bs_Cmp.cmj \
+    bs_Bag.cmj bs_Array.cmj
 bs_Set.cmj : bs_internalSet.cmj bs_internalAVLset.cmj bs_Cmp.cmj bs_Bag.cmj \
     bs_Set.cmi
 bs_SetM.cmj : bs_internalSet.cmj bs_internalAVLset.cmj bs_Cmp.cmj \
     bs_BagM.cmj bs_SetM.cmi
-bs_internalSetInt.cmj : bs_internalAVLset.cmj bs_Array.cmj
-bs_internalSetString.cmj : bs_internalAVLset.cmj bs_Array.cmj
+bs_internalSetInt.cmj : bs_internalAVLset.cmj bs_Stack.cmj bs_Array.cmj
+bs_internalSetString.cmj : bs_internalAVLset.cmj bs_Stack.cmj bs_Array.cmj
 bs_SetInt.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetInt.cmi
 bs_SetIntM.cmj : bs_internalSetInt.cmj bs_internalAVLset.cmj bs_SetIntM.cmi
 bs_SetString.cmj : bs_internalSetString.cmj bs_internalAVLset.cmj \
     bs_SetString.cmi
 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 :

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\

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

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 =

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. *)
 

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 ->

jscomp/others/bs_Stack.ml

@@ -0,0 +1,117 @@
+(* 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 
+
+
+
+let dynamicPopForAll2Unsafe s1 s2 b =   
+  let cursor1 = ref (root s1) in 
+  let cursor2 = ref (root s2) in 
+  let sofar = ref 0 in 
+  while 
+    !cursor1 != Js.null && 
+    !sofar = 0 do 
+      let v1 = Js.Null.castUnsafe !cursor1 in
+      rootSet s1 (tail v1);
+      let v2 = Js.Null.castUnsafe !cursor2 in 
+      rootSet s2 (tail v2);
+      sofar := b (head v1) (head v2) [@bs];
+      cursor1 := root s1; 
+      cursor2 := root s2
+  done; 
+  !sofar

jscomp/others/bs_Stack.mli

@@ -0,0 +1,62 @@
+(* 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
+*)
+
+val dynamicPopForAll2Unsafe:
+   'a t -> 'b t -> ('a -> 'b -> int [@bs]) -> int
+(** [dynamicPopForAll2Unsafe s1 s2 f] assume 
+  the dynamic length of [s1] and [s2] is equal
+*)

jscomp/others/bs_internalAVLset.ml

@@ -8,7 +8,7 @@ type 'elt node  = {
 [@@bs.deriving abstract]
 
 module A = Bs_Array
-
+module S = Bs_Stack
 external toOpt : 'a Js.null -> 'a option = "#null_to_opt"
 external return : 'a -> 'a Js.null = "%identity"
 external empty : 'a Js.null = "#null"
@@ -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,14 @@ 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 pushAllLeft v s =  
+  let current = ref v in 
+  while !current != Js.null do 
+    let v = Js.Null.castUnsafe !current in 
+    S.push s v; 
+    current := left v 
+  done 
 
 let rec iter0 n f = 
   match toOpt n with 
@@ -236,24 +235,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 +295,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