@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/belt_HashMap.mli

@@ -0,0 +1,436 @@
+(* Copyright (C) 2018 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. *)
+
+(**
+  A **mutable** Hash map which allows customized [`hash`]() behavior.
+
+  All data are parameterized by not its only type but also a unique identity in
+  the time of initialization, so that two _HashMaps of ints_ initialized with different
+  _hash_ functions will have different type.
+
+  For example:
+
+  ```
+  type t = int
+  module I0 = unpack(Belt.Id.hashableU(~hash=(. a: t) => \"&"(a, 0xff_ff), ~eq=(. a, b) => a == b))
+  let s0: t<_, string, _> = make(~hintSize=40, ~id=module(I0))
+
+  module I1 = unpack(Belt.Id.hashableU(~hash=(. a: t) => \"&"(a, 0xff), ~eq=(. a, b) => a == b))
+  let s1: t<_, string, _> = make(~hintSize=40, ~id=module(I1))
+  ```
+
+  The invariant must be held: for two elements who are _equal_,
+  their hashed value should be the same
+
+  Here the compiler would infer `s0` and `s1` having different type so that
+  it would not mix.
+
+  ```
+  let s0: t<int, I0.identity>
+  let s1: t<int, I1.identity>
+  ```
+
+  We can add elements to the collection:
+
+  ```
+  let () = {
+    add(s1, 0, "3")
+    add(s1, 1, "3")
+  }
+  ```
+
+  Since this is an mutable data strucure, `s1` will contain two pairs.
+*)
+
+
+(** Specalized when key type is `int`, more efficient
+    than the generic type *)
+module Int = Belt_HashMapInt
+
+
+(** Specalized when key type is `string`, more efficient
+    than the generic type *)
+module String = Belt_HashMapString
+
+
+
+
+type ('key,'value,'id) t
+(** The type of hash tables from type `'key` to type `'value`. *)
+
+type ('a, 'id) id = ('a, 'id) Belt_Id.hashable
+(** The identity needed for making an empty hash map. *)
+
+
+val make:  hintSize:int -> id:('key, 'id) id -> ('key,'value,'id) t
+(**
+  `make(~hintSize=10, ~id)` creates a new map by taking in the comparator and `hintSize`.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let hMap = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+
+  Belt.HashMap.set(hMap, 0, "a")
+  ```
+*)
+
+(*TODO: allow randomization for security *)
+
+val clear: ('key, 'value, 'id ) t -> unit
+(** 
+  Clears a hash table.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let hMap = Belt.HashMap.fromArray([(1, "1")], ~id=module(IntHash))
+  Belt.HashMap.clear(hMap)
+  Belt.HashMap.isEmpty(hMap) == true
+  ```
+*)
+
+val isEmpty: _ t -> bool
+(**
+  `isEmpty(m)` checks whether a hash map is empty.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  Belt.HashMap.isEmpty(Belt.HashMap.fromArray([(1, "1")], ~id=module(IntHash))) == false
+  ```
+*)
+
+val set: ('key, 'value, 'id ) t -> 'key -> 'value -> unit
+(**
+  `set(hMap, k, v)` if `k` does not exist, add the binding `k,v`, otherwise, update the old value with the new `v`.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.fromArray([(2, "2"), (1, "1"), (3, "3")], ~id=module(IntHash))
+
+  Belt.HashMap.set(s0, 2, "3")
+
+  Belt.HashMap.valuesToArray(s0) == ["1", "3", "3"]
+  ```
+*)
+
+val copy: ('key, 'value, 'id ) t -> ('key, 'value, 'id ) t
+(**
+  Creates copy of a hash map.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.fromArray([(2, "2"), (1, "1"), (3, "3")], ~id=module(IntHash))
+  let s1 = Belt.HashMap.copy(s0)
+
+  Belt.HashMap.set(s0, 2, "3")
+
+  Belt.HashMap.get(s0, 2) != Belt.HashMap.get(s1, 2)
+  ```
+*)
+
+val get: ('key, 'value, 'id ) t -> 'key -> 'value option
+(**
+Returns value bound under specific key. If values not exist returns `None`.
+
+```res example
+module IntHash = Belt.Id.MakeHashable({
+  type t = int
+  let hash = a => a
+  let eq = (a, b) => a == b
+})
+
+let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+Belt.HashMap.set(s0, 1, "value1")
+
+Belt.HashMap.get(s0, 1) == Some("value1")
+Belt.HashMap.get(s0, 2) == None
+```
+*)
+
+
+val has: ('key, 'value, 'id ) t -> 'key -> bool
+(** 
+  Checks if `x` is bound in `tbl`.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+
+  Belt.HashMap.has(s0, 1) == true
+  Belt.HashMap.has(s0, 2) == false
+  ```
+*)
+
+val remove: ('key, 'value, 'id ) t -> 'key ->  unit
+(**
+  If bound exists, removes it from the hash map.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.remove(s0, 1)
+  Belt.HashMap.has(s0, 1) == false
+  ```
+*)
+
+val forEachU: ('key, 'value, 'id ) t -> ('key -> 'value -> unit [@bs]) -> unit
+(** Same as [forEach](#forEach) but takes uncurried function. *)
+
+val forEach: ('key, 'value, 'id ) t -> ('key -> 'value -> unit) -> unit
+(**
+  `forEach(tbl, f)` applies `f` to all bindings in table `tbl`. `f` receives the key as first argument, and the associated value as second argument. Each binding is presented exactly once to `f`.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.forEach(s0, (key, value) => Js.log2(key, value))
+  // prints (1, "value1")
+  ```
+*)
+
+val reduceU: ('key, 'value, 'id ) t -> 'c -> ('c -> 'key -> 'value ->  'c [@bs]) ->  'c
+val reduce: ('key, 'value, 'id ) t -> 'c -> ('c -> 'key -> 'value ->  'c) ->  'c
+(**
+  `reduce(tbl, init, f)` computes `(f(kN, dN) ... (f(k1, d1, init))...)`, where `k1 ... kN` are the keys of all bindings in `tbl`, and `d1 ... dN` are the associated values. Each binding is presented exactly once to `f`.
+
+  The order in which the bindings are passed to `f` is unspecified. However, if the table contains several bindings for the same key, they are passed to `f` in reverse order of introduction, that is, the most recent binding is passed first.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.set(s0, 2, "value2")
+
+  Belt.HashMap.reduce(s0, "", (acc, key, value) => acc ++ (", " ++ value)) == "value1, value2"
+  ```
+*)
+
+val keepMapInPlaceU: ('key, 'value, 'id ) t -> ('key -> 'value -> 'value option [@bs]) ->  unit
+(** Same as [keepMapInPlace](#keepMapInPlace) but takes uncurried function.  *)
+
+val keepMapInPlace: ('key, 'value, 'id ) t -> ('key -> 'value -> 'value option ) ->  unit
+(**
+  Filters out values for which function `f` returned `None`.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.set(s0, 2, "value2")
+
+  Belt.HashMap.keepMapInPlace(s0, (key, value) => key == 1 ? None : Some(value))
+  ```
+*)
+
+val size: _ t -> int
+(** 
+  `size(tbl)` returns the number of bindings in `tbl`. It takes constant time.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.set(s0, 2, "value2")
+
+  Belt.HashMap.size(s0) == 2
+  ```
+*)
+
+val toArray: ('key, 'value, 'id ) t -> ('key * 'value) array
+(**
+  Returns array of key value pairs.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.set(s0, 2, "value2")
+
+  Belt.HashMap.toArray(s0) == [(1, "value1"), (2, "value2")]
+  ```
+*)
+
+val keysToArray: ('key, _, _) t -> 'key array
+(**
+  Returns array of keys.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.set(s0, 2, "value2")
+
+  Belt.HashMap.keysToArray(s0) == [1, 2]
+  ```
+ *)
+
+val valuesToArray: (_,'value,_) t -> 'value array
+(**
+  Returns array of values.
+
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+
+  let s0 = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(s0, 1, "value1")
+  Belt.HashMap.set(s0, 2, "value2")
+
+  Belt.HashMap.valuesToArray(s0) == ["value1", "value2"]
+  ```
+*)
+
+val fromArray: ('key * 'value) array -> id:('key,'id) id -> ('key, 'value, 'id ) t
+(**
+Creates new hash map from array of pairs.
+
+Returns array of values.
+
+```res example
+module IntHash = Belt.Id.MakeHashable({
+  type t = int
+  let hash = a => a
+  let eq = (a, b) => a == b
+})
+
+let s0 = Belt.HashMap.fromArray([(1, "value1"), (2, "value2")], ~id=module(IntHash))
+Belt.HashMap.toArray(s0) == [(1, "value1"), (2, "value2")]
+```
+*)
+
+val mergeMany: ('key, 'value, 'id ) t -> ('key * 'value) array -> unit
+(**
+```res example
+module IntHash = Belt.Id.MakeHashable({
+  type t = int
+  let hash = a => a
+  let eq = (a, b) => a == b
+})
+
+let hMap = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+Belt.HashMap.mergeMany(hMap, [(1, "1"), (2, "2")])
+```
+*)
+
+val getBucketHistogram: _ t -> int array
+(**
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+  let hMap = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(hMap, 1, "1")
+
+  Belt.HashMap.getBucketHistogram(hMap)
+  ```
+*)
+
+val logStats: _ t -> unit
+(**
+  ```res example
+  module IntHash = Belt.Id.MakeHashable({
+    type t = int
+    let hash = a => a
+    let eq = (a, b) => a == b
+  })
+  let hMap = Belt.HashMap.make(~hintSize=10, ~id=module(IntHash))
+  Belt.HashMap.set(hMap, 1, "1")
+
+  Belt.HashMap.logStats(hMap)
+  ```
+*)
+
+

package/lib/ocaml/belt_HashMapInt.ml

@@ -0,0 +1,206 @@
+# 1 "others/hashmap.cppo.ml"
+(***********************************************************************)
+(*                                                                     *)
+(*                                OCaml                                *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the GNU Library General Public License, with    *)
+(*  the special exception on linking described in file ../LICENSE.     *)
+(*                                                                     *)
+(***********************************************************************)
+(**  Adapted by Hongbo Zhang, Authors of ReScript 2017                           *)
+
+# 23 "others/hashmap.cppo.ml"
+type key = int
+type seed = int
+external caml_hash_mix_int : seed -> int -> seed  = "?hash_mix_int"
+external final_mix : seed -> seed = "?hash_final_mix"
+let hash (s : key) = 
+  final_mix (caml_hash_mix_int 0 s)
+
+# 33 "others/hashmap.cppo.ml"
+module N = Belt_internalBuckets
+module C = Belt_internalBucketsType
+module A = Belt_Array
+
+
+type 'b t = (unit, unit, key,'b) N.t
+
+
+let rec copyBucketReHash  ~h_buckets ~ndata_tail  (old_bucket : _ N.bucket  C.opt ) = 
+  match C.toOpt old_bucket with 
+  | None -> ()
+  | Some cell ->
+    let nidx = hash cell.key land (A.length h_buckets - 1) in 
+    let v = C.return cell in 
+    begin match C.toOpt (A.getUnsafe ndata_tail nidx) with
+      | None -> 
+        A.setUnsafe h_buckets nidx  v
+      | Some tail ->
+        tail.N.next <- v  (* cell put at the end *)            
+    end;          
+    A.setUnsafe ndata_tail nidx  v;
+    copyBucketReHash  ~h_buckets ~ndata_tail  cell.next
+
+
+let resize  h =
+  let odata = h.C.buckets in
+  let osize = A.length odata in
+  let nsize = osize * 2 in
+  if nsize >= osize then begin (* no overflow *)
+    let h_buckets = A.makeUninitialized nsize  in
+    let ndata_tail = A.makeUninitialized nsize  in (* keep track of tail *)
+    h.C.buckets <- h_buckets;          (* so that indexfun sees the new bucket count *)
+    for i = 0 to osize - 1 do
+      copyBucketReHash  ~h_buckets ~ndata_tail  (A.getUnsafe odata i)
+    done;
+    for i = 0 to nsize - 1 do
+      match C.toOpt (A.getUnsafe ndata_tail i) with
+      | None -> ()
+      | Some tail -> tail.next <- C.emptyOpt
+    done
+  end
+
+
+let rec replaceInBucket  (key : key) info cell = 
+    if  cell.N.key = key 
+    then
+      begin
+        cell.N.value <- info;
+        false
+      end
+    else
+    match C.toOpt cell.next with 
+    | None -> true 
+    | Some cell -> 
+      replaceInBucket key info cell
+
+let set  h (key : key) value =
+  let h_buckets = h.C.buckets in 
+  let buckets_len = A.length h_buckets in 
+  let i = hash key land (buckets_len - 1) in 
+  let l = A.getUnsafe h_buckets i in  
+  (match C.toOpt l with 
+  | None -> 
+    A.setUnsafe h_buckets i (C.return {N.key; value; next = C.emptyOpt});
+    h.C.size <- (h.C.size + 1);
+  | Some bucket -> 
+      if replaceInBucket key value bucket then begin
+        A.setUnsafe h_buckets i (C.return {N.key; value; next = l});
+        h.C.size <- (h.C.size + 1);
+      end   
+    );
+    if h.C.size > buckets_len lsl 1 then resize h 
+
+
+
+let rec removeInBucket h h_buckets  i (key : key) prec buckets =
+  match C.toOpt buckets with
+  | None -> ()
+  | Some cell  ->
+    let cell_next = cell.N.next in 
+    if  cell.N.key = key 
+    then 
+      begin
+        prec.N.next <-cell_next;
+        h.C.size <- (h.C.size - 1);        
+      end
+    else removeInBucket  h h_buckets i key cell cell_next
+
+let remove  h key =  
+  let h_buckets = h.C.buckets in 
+  let i = hash key land (A.length h_buckets - 1) in  
+  let bucket = (A.getUnsafe h_buckets i) in 
+  match C.toOpt bucket with 
+  | None -> ()
+  | Some cell -> 
+    if cell.N.key = key then 
+    begin 
+      A.setUnsafe h_buckets i cell.next;
+      h.C.size <- (h.C.size - 1)
+    end 
+    else 
+      removeInBucket  h h_buckets i key cell cell.next
+
+
+
+let rec getAux  (key : key) buckets = 
+  match C.toOpt buckets with 
+  | None ->
+    None
+  | Some cell ->
+    if key = cell.N.key  then Some cell.N.value 
+    else getAux key  cell.next
+
+let get  h (key : key) =
+  let h_buckets = h.C.buckets in 
+  let nid = hash key  land (A.length h_buckets - 1) in 
+  match C.toOpt (A.getUnsafe h_buckets nid) with
+  | None -> None
+  | Some cell1 ->
+    if key = cell1.N.key  then Some cell1.N.value else
+      match C.toOpt cell1.N.next with
+      | None -> None
+      | Some cell2 ->
+        if  key = cell2.N.key  then Some cell2.N.value else
+          match C.toOpt cell2.N.next with
+          | None -> None
+          | Some cell3 ->
+            if  key = cell3.N.key  then Some cell3.N.value
+            else getAux  key cell3.N.next
+
+
+let rec memInBucket (key : key) cell = 
+    cell.N.key  = key  ||
+    (match C.toOpt cell.next with 
+    | None -> false
+    | Some nextCell -> memInBucket  key nextCell
+     )
+    
+let has h key =
+  let h_buckets = h.C.buckets in 
+  let nid = hash key land (A.length h_buckets - 1) in 
+  let bucket = A.getUnsafe h_buckets nid in 
+  match C.toOpt bucket with 
+  | None -> false
+  | Some bucket -> 
+    memInBucket  key bucket
+
+
+let make ~hintSize = C.make ~hintSize ~hash:() ~eq:()
+let clear = C.clear
+let size h = h.C.size
+let forEachU = N.forEachU 
+let forEach = N.forEach
+let reduceU = N.reduceU
+let reduce = N.reduce               
+let logStats = N.logStats
+let keepMapInPlaceU = N.keepMapInPlaceU 
+let keepMapInPlace = N.keepMapInPlace
+let toArray = N.toArray
+let copy = N.copy
+let keysToArray = N.keysToArray
+let valuesToArray = N.valuesToArray
+let getBucketHistogram = N.getBucketHistogram 
+let isEmpty = C.isEmpty
+
+let fromArray arr = 
+  let len = A.length arr in 
+  let v = make ~hintSize:len in 
+  for i = 0 to len - 1 do 
+    let k,value = (A.getUnsafe arr i) in
+    set v k value
+  done ;
+  v
+
+(* TOOD: optimize heuristics for resizing *)  
+let mergeMany h arr =   
+  let len = A.length arr in 
+  for i = 0 to len - 1 do 
+    let k,v = (A.getUnsafe arr i) in
+    set h k v 
+  done
+

package/lib/ocaml/belt_HashMapInt.mli

@@ -0,0 +1,50 @@
+# 4 "others/hashmap.cppo.mli"
+type key = int
+
+
+# 10 "others/hashmap.cppo.mli"
+type 'b t
+
+
+val make:  hintSize:int -> 'b t
+
+val clear: 'b t -> unit
+
+val isEmpty: _ t -> bool
+
+val set: 'a t -> key -> 'a -> unit
+(**
+  `setDone tbl k v` if `k` does not exist,
+  add the binding `k,v`, otherwise, update the old value with the new
+  `v`
+*)
+
+
+val copy: 'a t -> 'a t
+val get:  'a t -> key -> 'a option
+
+val has:  'b  t -> key -> bool
+
+val remove: 'a t -> key -> unit
+
+val forEachU: 'b t -> (key -> 'b -> unit [@bs]) -> unit
+val forEach: 'b t -> (key -> 'b -> unit) -> unit
+
+val reduceU: 'b t -> 'c -> ('c -> key -> 'b ->  'c [@bs]) -> 'c
+val reduce: 'b t -> 'c -> ('c -> key -> 'b ->  'c) -> 'c
+
+val keepMapInPlaceU: 'a t ->  (key -> 'a -> 'a option [@bs]) -> unit
+val keepMapInPlace: 'a t ->  (key -> 'a -> 'a option) -> unit
+
+
+val size: _ t -> int
+
+
+val toArray: 'a t -> (key * 'a) array
+val keysToArray: 'a t -> key array
+val valuesToArray: 'a t -> 'a array
+val fromArray: (key * 'a) array -> 'a t
+val mergeMany: 'a t -> (key * 'a) array -> unit
+val getBucketHistogram: _ t -> int array
+val logStats: _ t -> unit
+