@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/belt_MapString.mli

@@ -0,0 +1,187 @@
+# 2 "others/map.cppo.mli"
+type key = string
+# 8 "others/map.cppo.mli"
+type 'value t
+(** The type of maps from type `key` to type `'value`. *)
+
+val empty: 'v t
+
+val isEmpty: 'v t -> bool
+
+val has: 'v t -> key -> bool
+
+val cmpU: 'v t -> 'v t -> ('v -> 'v -> int [@bs]) -> int
+val cmp: 'v t -> 'v t -> ('v -> 'v -> int) -> int
+
+val eqU: 'v t -> 'v t -> ('v -> 'v -> bool [@bs]) -> bool
+val eq: 'v t -> 'v t -> ('v -> 'v -> bool) -> bool
+(**
+  `eq m1 m2` tests whether the maps `m1` and `m2` are
+  equal, that is, contain equal keys and associate them with
+  equal data.
+*)
+
+val findFirstByU : 'v t -> (key -> 'v -> bool [@bs]) -> (key * 'v) option
+val findFirstBy : 'v t -> (key -> 'v -> bool) -> (key * 'v) option
+(**
+  `findFirstBy m p` uses funcion `f` to find the first key value pair
+  to match predicate `p`.
+
+  ```
+  let s0 = fromArray ~id:(module IntCmp) [|4,"4";1,"1";2,"2,"3""|];;
+  findFirstBy s0 (fun k v -> k = 4 ) = option (4, "4");;
+  ```
+*)
+
+val forEachU: 'v t -> (key -> 'v -> unit [@bs]) -> unit
+val forEach: 'v t -> (key -> 'v -> unit) -> unit
+(**
+  `forEach m f` applies `f` to all bindings in map `m`.
+  `f` receives the key as first argument, and the associated value
+  as second argument. The bindings are passed to `f` in increasing
+  order with respect to the ordering over the type of the keys.
+*)
+
+val reduceU: 'v t -> 'v2 -> ('v2 -> key -> 'v -> 'v2 [@bs]) -> 'v2
+val reduce: 'v t -> 'v2 -> ('v2 -> key -> 'v -> 'v2) -> 'v2
+(**
+  `reduce m a f` computes `(f kN dN ... (f k1 d1 a)...)`,
+  where `k1 ... kN` are the keys of all bindings in `m`
+  (in increasing order), and `d1 ... dN` are the associated data.
+*)
+
+val everyU: 'v t -> (key -> 'v -> bool [@bs]) -> bool
+val every: 'v t -> (key -> 'v -> bool) -> bool
+(** `every m p` checks if all the bindings of the map
+    satisfy the predicate `p`. Order unspecified *)
+
+val someU: 'v t -> (key -> 'v -> bool [@bs]) -> bool
+val some: 'v t -> (key -> 'v -> bool) -> bool
+(** `some m p` checks if at least one binding of the map
+    satisfy the predicate `p`. Order unspecified *)
+
+val size: 'v t -> int
+
+val toList: 'v t -> (key * 'v) list
+(** In increasing order. *)
+
+val toArray: 'v t -> (key * 'v) array
+
+
+val fromArray: (key * 'v) array -> 'v t
+
+val keysToArray: 'v t -> key array
+
+val valuesToArray: 'v t -> 'v array
+
+val minKey: _ t -> key option
+
+val minKeyUndefined: _ t -> key Js.undefined
+
+val maxKey: _ t -> key option
+
+val maxKeyUndefined: _ t -> key Js.undefined
+
+val minimum: 'v t -> (key * 'v) option
+
+val minUndefined: 'v t -> (key * 'v) Js.undefined
+
+val maximum: 'v t -> (key * 'v) option
+
+val maxUndefined: 'v t -> (key * 'v) Js.undefined
+
+val get: 'v t -> key -> 'v option
+
+val getUndefined: 'v t -> key -> 'v Js.undefined
+
+val getWithDefault: 'v t -> key -> 'v -> 'v
+
+val getExn: 'v t -> key -> 'v
+
+val checkInvariantInternal: _ t -> unit
+(**
+  **raise** when invariant is not held
+*)
+
+val remove: 'v t -> key -> 'v t
+(** `remove m x` returns a map containing the same bindings as
+    `m`, except for `x` which is unbound in the returned map. *)
+
+val removeMany: 'v t -> key array -> 'v t
+
+val set: 'v t -> key -> 'v -> 'v t
+(**
+  `set m x y` returns a map containing the same bindings as
+  `m`, plus a binding of `x` to `y`. If `x` was already bound
+  in `m`, its previous binding disappears.
+*)
+
+val updateU: 'v t -> key -> ('v option -> 'v option [@bs]) -> 'v t
+val update: 'v t -> key -> ('v option -> 'v option) -> 'v t
+
+val mergeU:
+  'v t -> 'v2 t ->
+  (key -> 'v option -> 'v2 option -> 'c option [@bs]) ->
+  'c t
+val merge:
+  'v t -> 'v2 t ->
+  (key -> 'v option -> 'v2 option -> 'c option) ->
+  'c t
+(**
+  `merge m1 m2 f` computes a map whose keys is a subset of keys of `m1`
+  and of `m2`. The presence of each such binding, and the corresponding
+  value, is determined with the function `f`.
+*)
+
+val mergeMany: 'v t -> (key * 'v) array -> 'v t
+
+
+val keepU:
+  'v t ->
+  (key -> 'v -> bool [@bs]) ->
+  'v t
+val keep:
+  'v t ->
+  (key -> 'v -> bool) ->
+  'v t
+(** `keep m p` returns the map with all the bindings in `m`
+    that satisfy predicate `p`. *)
+
+val partitionU:
+  'v t ->
+  (key -> 'v -> bool [@bs]) ->
+  'v t * 'v t
+val partition:
+  'v t ->
+  (key -> 'v -> bool) ->
+  'v t * 'v t
+(**
+  `partition m p` returns a pair of maps `(m1, m2)`, where
+  `m1` contains all the bindings of `s` that satisfy the
+  predicate `p`, and `m2` is the map with all the bindings of
+  `s` that do not satisfy `p`.
+*)
+
+val split: key -> 'v t -> 'v t * 'v option * 'v t
+(**
+  `split x m` returns a triple `(l, data, r)`, where
+  `l` is the map with all the bindings of `m` whose key
+  is strictly less than `x`;
+  `r` is the map with all the bindings of `m` whose key
+  is strictly greater than `x`;
+  `data` is `None` if `m` contains no binding for `x`,
+  or `Some v` if `m` binds `v` to `x`.
+*)
+
+val mapU: 'v t -> ('v -> 'v2 [@bs]) -> 'v2 t
+val map: 'v t -> ('v -> 'v2) -> 'v2 t
+(**
+  `map m f` returns a map with same domain as `m`, where the
+  associated value `a` of all bindings of `m` has been
+  replaced by the result of the application of `f` to `a`.
+  The bindings are passed to `f` in increasing order
+  with respect to the ordering over the type of the keys.
+*)
+
+val mapWithKeyU: 'v t -> (key -> 'v -> 'v2 [@bs]) -> 'v2 t
+val mapWithKey: 'v t -> (key -> 'v -> 'v2) -> 'v2 t

package/lib/ocaml/belt_MutableMap.ml

@@ -0,0 +1,241 @@
+
+(* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript
+ * 
+ * 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. *)
+
+module Int = Belt_MutableMapInt
+module String = Belt_MutableMapString
+    
+module N = Belt_internalAVLtree
+module A = Belt_Array
+
+
+type ('key, 'id) id = ('key, 'id) Belt_Id.comparable
+type ('key, 'id ) cmp = ('key, 'id) Belt_Id.cmp
+    
+
+type ('k, 'v, 'id) t = {
+  cmp: ('k, 'id) cmp;
+  mutable data: ('k, 'v) N.t
+} 
+
+
+
+let rec removeMutateAux nt x ~cmp = 
+  let k = nt.N.key in 
+  let c = (Belt_Id.getCmpInternal cmp) x k [@bs] in 
+  if c = 0 then 
+    let {N.left = l; right = r} = nt in       
+    match l, r with 
+    | Some _,  Some nr ->  
+      nt.right <- (N.removeMinAuxWithRootMutate nt nr);
+      Some (N.balMutate nt)
+    | None, Some _ ->
+      r  
+    | (Some _ | None ), None ->  l 
+  else 
+    begin 
+      if c < 0 then 
+        match  nt.N.left with         
+        | None -> Some nt 
+        | Some l ->
+          nt.left <- (removeMutateAux ~cmp l x );
+          Some (N.balMutate nt)
+      else 
+        match  nt.right with 
+        | None -> Some nt 
+        | Some r -> 
+          nt.right <- (removeMutateAux ~cmp r x);
+          Some (N.balMutate nt)
+    end    
+
+let remove d k =  
+  let oldRoot = d.data in   
+  match  oldRoot with 
+  | None -> ()
+  | Some oldRoot2 ->
+    let newRoot = removeMutateAux ~cmp:(d.cmp) oldRoot2 k in 
+    if newRoot != oldRoot then 
+      d.data <- newRoot    
+
+
+let rec removeArrayMutateAux t xs i len ~cmp  =  
+  if i < len then 
+    let ele = A.getUnsafe xs i in 
+    let u = removeMutateAux t ele ~cmp in 
+    match  u with 
+    | None -> None
+    | Some t -> removeArrayMutateAux t xs (i+1) len ~cmp 
+  else Some t    
+
+let removeMany d xs =  
+  let oldRoot = d.data in 
+  match  oldRoot with 
+  | None -> ()
+  | Some nt -> 
+    let len = A.length xs in 
+    let newRoot = removeArrayMutateAux nt xs 0 len ~cmp:(d.cmp) in 
+    if newRoot != oldRoot then 
+      d.data <- newRoot
+
+
+let rec updateDone t x   f  ~cmp =   
+  match  t with 
+  | None ->
+    (match f None [@bs] with
+    | Some data -> N.singleton x data
+    | None -> t)
+  | Some nt -> 
+    let k = nt.N.key in 
+    let  c = (Belt_Id.getCmpInternal cmp) x k [@bs] in  
+    if c = 0 then begin     
+      match f (Some nt.value) [@bs] with
+      | None ->
+        let {N.left = l; right = r} = nt in
+        begin match  l,  r with
+        | Some _, Some nr ->
+          nt.right <- (N.removeMinAuxWithRootMutate nt nr);
+          Some (N.balMutate nt)
+        | None, Some _ ->
+          r
+        | (Some _ | None), None -> l
+        end
+      | Some data -> 
+        nt.value <- data;
+        Some nt
+    end      
+    else begin       
+      (if c < 0 then                            
+         nt.left <- updateDone  nt.left x f ~cmp 
+       else   
+         nt.right <- updateDone  nt.right x f ~cmp
+      );
+      Some (N.balMutate nt)  
+    end  
+let updateU t  x f =       
+  let oldRoot = t.data in 
+  let newRoot = updateDone oldRoot x f ~cmp:(t.cmp) in 
+  if  newRoot != oldRoot then 
+    t.data <- newRoot 
+let update t x f = updateU t x (fun [@bs] a -> f a)
+    
+let make (type key) (type identity) ~(id : (key,identity) id) =
+  let module M = (val id) in 
+  {cmp = M.cmp ; data = None}
+
+let clear m = m.data <- None
+    
+let isEmpty d = 
+  N.isEmpty (d.data)
+    
+
+let minKey m = N.minKey (m.data)
+let minKeyUndefined m = N.minKeyUndefined (m.data)
+let maxKey m = N.maxKey (m.data)
+let maxKeyUndefined m = N.maxKeyUndefined (m.data)
+let minimum m = N.minimum (m.data)
+let minUndefined m = N.minUndefined (m.data) 
+let maximum m = N.maximum (m.data)
+let maxUndefined m = N.maxUndefined (m.data)
+
+let forEachU d f = N.forEachU (d.data) f
+let forEach d f = forEachU d (fun [@bs] a b -> f a b)
+let reduceU d acc cb = N.reduceU (d.data) acc cb
+let reduce d acc cb = reduceU d acc (fun[@bs] a b c -> cb a b c)
+let everyU d p = N.everyU (d.data) p
+let every d p = everyU d (fun[@bs] a b -> p a b)
+let someU d p = N.someU (d.data) p       
+let some d p = someU d (fun [@bs] a b -> p a b)
+let size d = 
+  N.size (d.data)
+let toList d =
+  N.toList (d.data)
+let toArray d = 
+  N.toArray (d.data)
+let keysToArray d =   
+  N.keysToArray (d.data)
+let valuesToArray d =   
+  N.valuesToArray (d.data)
+    
+(* let fromSortedArrayUnsafe (type key) (type identity) ~(id : (key,identity) id) xs : _ t =
+  let module M = (val id) in 
+  S.t ~data:(N.fromSortedArrayUnsafe xs) ~cmp:M.cmp *)
+    
+let checkInvariantInternal d = 
+  N.checkInvariantInternal (d.data)  
+
+let cmpU m1 m2 cmp = 
+  N.cmpU ~kcmp:(m1.cmp) ~vcmp:cmp (m1.data) (m2.data)
+let cmp m1 m2 cmp = cmpU m1 m2 (fun[@bs] a b -> cmp a b)
+    
+let eqU m1 m2 cmp = 
+  N.eqU ~kcmp:(m1.cmp) ~veq:cmp (m1.data) (m2.data)
+let eq m1 m2 cmp = eqU m1 m2 (fun[@bs] a b -> cmp a b)
+
+let mapU m f = 
+  {cmp = m.cmp; data = N.mapU (m.data) f}
+let map m f = mapU m (fun[@bs] a  -> f a )    
+let mapWithKeyU m f = 
+  {cmp = m.cmp; data = N.mapWithKeyU (m.data) f}
+let mapWithKey m f = mapWithKeyU m (fun [@bs] a b -> f a b)     
+let get m x  = 
+  N.get ~cmp:(m.cmp)  (m.data) x
+    
+let getUndefined m x = 
+  N.getUndefined ~cmp:(m.cmp)  (m.data) x
+    
+let getWithDefault m x def = 
+  N.getWithDefault ~cmp:(m.cmp) (m.data) x  def
+    
+let getExn m x = 
+  N.getExn ~cmp:(m.cmp) (m.data) x
+    
+let has m x = 
+  N.has ~cmp:(m.cmp) (m.data) x
+    
+let fromArray (type k  identity) data ~(id : (k,identity) id)= 
+  let module M = (val id ) in
+  let cmp = M.cmp in 
+  {cmp; data = N.fromArray ~cmp data}
+  
+let set  m e v = 
+  let oldRoot = m.data in 
+  let newRoot = N.updateMutate ~cmp:(m.cmp) oldRoot e v in 
+  if newRoot != oldRoot then 
+    m.data <- newRoot
+
+let mergeManyAux t  xs ~cmp =     
+  let v = ref t in 
+  for i = 0 to A.length xs - 1 do 
+    let key,value = A.getUnsafe xs i in 
+    v .contents<- N.updateMutate v.contents key value ~cmp
+  done; 
+  v.contents 
+
+let mergeMany d xs =   
+  let oldRoot = d.data in 
+  let newRoot = mergeManyAux oldRoot xs ~cmp:(d.cmp) in 
+  if newRoot != oldRoot then 
+    d.data <- newRoot
+
+

package/lib/ocaml/belt_MutableMap.mli

@@ -0,0 +1,145 @@
+(* Copyright (C) 2017 Authors of ReScript
+ *
+ * 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. *)
+
+module Int = Belt_MutableMapInt
+
+module String = Belt_MutableMapString
+
+
+(** A mutable sorted map module which allows customize compare behavior.
+
+    Same as `Belt.Map`, but mutable.
+*)
+
+(*  ```res prelude
+    type t<'k, 'v, 'id>
+    type id<'key, 'id> = Belt_Id.comparable<'key, 'id>
+    ```
+*)
+
+type ('k,'v,'id) t
+type ('key, 'id) id = ('key, 'id) Belt_Id.comparable
+
+val make: id:('k, 'id) id -> ('k, 'a, 'id) t
+val clear: _ t -> unit
+val isEmpty: _ t -> bool
+val has: ('k, _, _) t -> 'k  -> bool
+
+val cmpU:
+  ('k, 'a, 'id) t ->
+  ('k, 'a, 'id) t ->
+  ('a -> 'a -> int [@bs]) ->
+  int
+val cmp:
+  ('k, 'a, 'id) t ->
+  ('k, 'a, 'id) t ->
+  ('a -> 'a -> int ) ->
+  int
+(** `cmp(m1, m2, cmp)` First compare by size, if size is the same, compare by
+    key, value pair. *)
+
+val eqU:  ('k, 'a, 'id) t -> ('k, 'a, 'id) t -> ('a -> 'a -> bool [@bs]) -> bool
+val eq:  ('k, 'a, 'id) t -> ('k, 'a, 'id) t -> ('a -> 'a -> bool) -> bool
+(** `eq(m1, m2, eqf)` tests whether the maps `m1` and `m2` are equal, that is,
+    contain equal keys and associate them with equal data. `eqf` is the
+    equality predicate used to compare the data associated with the keys. *)
+
+val forEachU:  ('k, 'a, 'id) t -> ('k -> 'a -> unit [@bs]) -> unit
+val forEach:  ('k, 'a, 'id) t -> ('k -> 'a -> unit) -> unit
+(** `forEach(m, f)` applies f to all bindings in map `m`. `f` receives the `'k`
+    as first argument, and the associated value as second argument. The
+    bindings are passed to `f` in increasing order with respect to the ordering
+    over the type of the keys. *)
+
+val reduceU: ('k, 'a, 'id) t -> 'b ->  ('b -> 'k -> 'a -> 'b [@bs]) ->  'b
+val reduce: ('k, 'a, 'id) t -> 'b ->  ('b -> 'k -> 'a -> 'b) ->  'b
+(** `reduce(m, a, f), computes`(f(kN, dN) ... (f(k1, d1, a))...)`, where`k1 ...
+    kN`are the keys of all bindings in`m`(in increasing order), and`d1 ... dN`
+    are the associated data. *)
+
+val everyU: ('k, 'a, 'id) t -> ('k -> 'a -> bool [@bs]) ->  bool
+val every: ('k, 'a, 'id) t -> ('k -> 'a -> bool) ->  bool
+(** `every(m, p)` checks if all the bindings of the map satisfy the predicate
+    `p`. *)
+
+
+val someU: ('k, 'a, 'id) t -> ('k -> 'a -> bool [@bs]) ->  bool
+val some: ('k, 'a, 'id) t -> ('k -> 'a -> bool) ->  bool
+(** `some(m, p)` checks if at least one binding of the map satisfy the
+    predicate `p`. *)
+
+val size: ('k, 'a, 'id) t -> int
+
+
+val toList: ('k, 'a, 'id) t -> ('k * 'a) list
+(** In increasing order. *)
+
+val toArray: ('k, 'a, 'id) t -> ('k * 'a) array
+
+val fromArray: ('k * 'a) array -> id:('k,'id) id ->  ('k,'a,'id) t
+val keysToArray: ('k, _, _) t -> 'k array
+val valuesToArray: (_, 'a, _) t -> 'a array
+val minKey: ('k, _,  _) t -> 'k option
+val minKeyUndefined: ('k, _,  _) t -> 'k Js.undefined
+val maxKey: ('k, _,  _) t -> 'k option
+val maxKeyUndefined: ('k, _,  _) t -> 'k Js.undefined
+val minimum: ('k, 'a,  _) t -> ('k * 'a) option
+val minUndefined: ('k, 'a, _) t -> ('k * 'a) Js.undefined
+val maximum: ('k, 'a, _) t -> ('k * 'a) option
+val maxUndefined:('k, 'a, _) t -> ('k * 'a) Js.undefined
+val get:  ('k, 'a, 'id) t -> 'k -> 'a option
+val getUndefined: ('k, 'a, 'id) t -> 'k ->  'a Js.undefined
+val getWithDefault:
+  ('k, 'a, 'id) t -> 'k ->  'a -> 'a
+val getExn:  ('k, 'a, 'id) t -> 'k ->  'a
+val checkInvariantInternal: _ t -> unit
+(** Raise when invariant is not held. *)
+
+
+(****************************************************************************)
+
+(*TODO: add functional `merge, partition, keep, split`*)
+
+val remove:  ('k, 'a, 'id) t -> 'k -> unit
+(** `remove(m, x)` do the in-place modification. *)
+
+val removeMany: ('k, 'a, 'id) t -> 'k array -> unit
+
+val set: ('k, 'a, 'id) t -> 'k -> 'a ->  unit
+(** `set(m, x, y)` do the in-place modification *)
+
+val updateU: ('k, 'a, 'id) t -> 'k -> ('a option -> 'a option [@bs]) -> unit
+val update: ('k, 'a, 'id) t -> 'k -> ('a option -> 'a option) -> unit
+
+val mergeMany:  ('k, 'a, 'id) t -> ('k * 'a) array ->  unit
+
+val mapU: ('k, 'a, 'id) t -> ('a -> 'b [@bs]) ->  ('k ,'b,'id ) t
+val map: ('k, 'a, 'id) t -> ('a -> 'b) ->  ('k ,'b,'id ) t
+(** `map(m, f)` returns a map with same domain as `m`, where the associated
+    value a of all bindings of `m` has been replaced by the result of the
+    application of `f` to `a`. The bindings are passed to `f` in increasing
+    order with respect to the ordering over the type of the keys. *)
+
+val mapWithKeyU: ('k, 'a, 'id) t -> ('k -> 'a -> 'b [@bs]) -> ('k, 'b, 'id) t
+val mapWithKey: ('k, 'a, 'id) t -> ('k -> 'a -> 'b) -> ('k, 'b, 'id) t