@tellahq/rescript 10.1.4-republish-2 → 10.1.4-republish-3

package/lib/ocaml/belt_HashMapString.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                           *)
+
+# 16 "others/hashmap.cppo.ml"
+type key = string
+type seed = int
+external caml_hash_mix_string : seed -> string -> seed  = "?hash_mix_string"
+external final_mix : seed -> seed = "?hash_final_mix"
+let hash (s : key) =   
+  final_mix  (caml_hash_mix_string 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_HashMapString.mli

@@ -0,0 +1,50 @@
+# 2 "others/hashmap.cppo.mli"
+type key = string
+
+
+# 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
+

package/lib/ocaml/belt_HashSet.ml

@@ -0,0 +1,196 @@
+(* 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_HashSetInt
+
+module String = Belt_HashSetString
+
+
+module N = Belt_internalSetBuckets
+module C = Belt_internalBucketsType
+module A = Belt_Array
+
+type ('a, 'id) eq = ('a, 'id) Belt_Id.eq
+type ('a, 'id) hash = ('a, 'id) Belt_Id.hash
+type ('a, 'id) id = ('a, 'id) Belt_Id.hashable
+
+type ('a,'id) t =  ( ('a, 'id) hash, ('a, 'id) eq, 'a) N.t
+
+
+
+let rec copyBucket ~hash ~h_buckets ~ndata_tail  old_bucket = 
+  match C.toOpt old_bucket with 
+  | None -> ()
+  | Some cell ->
+    let nidx = (Belt_Id.getHashInternal hash) cell.N.key [@bs] 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;
+    copyBucket ~hash ~h_buckets ~ndata_tail  cell.N.next
+
+
+let tryDoubleResize ~hash 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.buckets <- h_buckets;          (* so that indexfun sees the new bucket count *)
+    for i = 0 to osize - 1 do
+      copyBucket ~hash ~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.N.next <- C.emptyOpt
+    done
+  end
+
+
+
+let rec removeBucket ~eq h h_buckets  i key prec cell =
+  let cell_next = cell.N.next in 
+  if (Belt_Id.getEqInternal eq) cell.N.key key [@bs]
+  then 
+    begin
+      prec.N.next <- cell_next;
+      h.C.size <- (h.C.size - 1);        
+    end
+  else 
+    match C.toOpt cell_next with 
+    | None -> 
+      ()
+    | Some cell_next ->
+      removeBucket ~eq h h_buckets i key cell cell_next
+
+let remove h key = 
+  let eq = h.C.eq in 
+  let h_buckets = h.C.buckets in 
+  let i = (Belt_Id.getHashInternal h.C.hash) key [@bs] land (A.length h_buckets - 1) in  
+  let l = A.getUnsafe h_buckets i in 
+  match C.toOpt l with 
+  | None -> ()
+  | Some cell -> 
+    let next_cell = cell.N.next in 
+    if (Belt_Id.getEqInternal eq) cell.N.key key [@bs] then 
+      begin 
+        h.C.size <- (h.C.size - 1) ;
+        A.setUnsafe h_buckets i next_cell
+      end
+    else       
+      match C.toOpt next_cell with 
+      | None -> ()
+      | Some next_cell -> 
+        removeBucket ~eq h h_buckets i key cell next_cell
+  
+
+
+let rec addBucket h key  cell  ~eq = 
+  if not ((Belt_Id.getEqInternal eq) cell.N.key key [@bs]) then
+    let  n = cell.N.next in 
+    match C.toOpt n with 
+    | None ->  
+      h.C.size <- (h.C.size + 1);
+      cell.N.next <- C.return { N.key; next = C.emptyOpt}
+    | Some n -> addBucket ~eq h key  n
+
+let add0 h key  ~hash  ~eq =
+  let h_buckets = h.C.buckets in 
+  let buckets_len = A.length h_buckets in 
+  let i = (Belt_Id.getHashInternal hash) key [@bs] land (buckets_len - 1) in 
+  let l = A.getUnsafe h_buckets i in  
+  (match C.toOpt l with                                    
+   | None -> 
+     h.C.size <- (h.C.size+ 1);
+     A.setUnsafe h_buckets i 
+       (C.return { N.key; next = C.emptyOpt})
+   | Some cell -> 
+     addBucket ~eq h key cell);
+  if h.C.size > buckets_len lsl 1 then tryDoubleResize ~hash h
+
+let add h key  = 
+  add0 ~hash:h.C.hash ~eq:h.C.eq h  key 
+
+let rec memInBucket ~eq key cell = 
+  (Belt_Id.getEqInternal eq) 
+    cell.N.key key [@bs] || 
+  (match C.toOpt cell.N.next with 
+   | None -> false 
+   | Some nextCell -> 
+     memInBucket ~eq key nextCell)
+
+
+  
+let has h key =           
+  let eq, h_buckets = h.C.eq, h.C.buckets  in 
+  let nid = (Belt_Id.getHashInternal h.C.hash) key [@bs] 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 ~eq key bucket
+
+
+
+
+let make (type value) (type identity)  ~hintSize ~(id: (value, identity) id)=
+  let module M = (val id) in 
+  C.make ~hintSize ~hash:M.hash ~eq:M.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 toArray  = N.toArray
+let copy = N.copy
+let getBucketHistogram  = N.getBucketHistogram 
+let isEmpty  = C.isEmpty
+
+let fromArray (type a identity) arr ~(id:(a,identity) id)  =     
+  let module M = (val id) in 
+  let eq, hash = M.eq , M.hash in 
+    let len = A.length arr in 
+  let v = C.make ~hintSize:len ~hash ~eq  in 
+  for i = 0 to len - 1 do 
+    add0 ~eq ~hash v (A.getUnsafe arr i)
+  done ;
+  v
+
+let mergeMany h arr = 
+  let eq, hash = h.C.eq, h.hash in 
+  let len = A.length arr in 
+  for i = 0 to len - 1 do 
+    add0 h  ~eq ~hash (A.getUnsafe arr i)
+  done 
+  
+

package/lib/ocaml/belt_HashSet.mli

@@ -0,0 +1,125 @@
+(* 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 set 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 _HashSets of ints_ initialized with
+  different _hash_ functions will have different type.
+
+  For example:
+
+  ```res prelude
+  module I0 = unpack(
+    Belt.Id.hashableU(
+      ~hash=(. a: int) => land(a, 65535),
+      ~eq=(. a, b) => a == b,
+    )
+  )
+
+  let s0 = Belt.HashSet.make(~id=module(I0), ~hintSize=40)
+
+  module I1 = unpack(
+    Belt.Id.hashableU(
+      ~hash=(. a: int) => land(a, 255),
+      ~eq=(. a, b) => a == b,
+    )
+  )
+
+  let s1 = Belt.HashSet.make(~id=module(I1), ~hintSize=40)
+
+  Belt.HashSet.add(s1, 0)
+  Belt.HashSet.add(s1, 1)
+  ```
+
+  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.
+
+  ```res sig
+  let s0: Belt.HashSet.t<int, I0.identity>
+  let s1: Belt.HashSet.t<int, I1.identity>
+  ```
+
+  We can add elements to the collection (see last two lines in the example
+  above). Since this is an mutable data structure, `s1` will contain two pairs.
+*)
+
+
+(** Specalized when key type is `int`, more efficient
+    than the generic type *)
+module Int = Belt_HashSetInt
+
+(** Specalized when key type is `string`, more efficient
+    than the generic type *)
+module String = Belt_HashSetString
+
+(* TODO: add a poly module
+   module Poly = Belt_HashSetPoly
+   challenge:
+   - generic equal handles JS data structure
+   - eq/hash consistent
+*)
+
+type ('a, 'id) t
+
+(** The type of hash tables from type `'a` to type `'b`. *)
+type ('a, 'id) id = ('a, 'id) Belt_Id.hashable
+
+val make:  hintSize:int -> id:('a,'id) id ->  ('a, 'id) t
+val clear: ('a, 'id) t -> unit
+val isEmpty: _ t -> bool
+
+val add: ('a, 'id) t -> 'a -> unit
+
+val copy: ('a, 'id) t -> ('a, 'id) t
+
+val has: ('a, 'id) t -> 'a -> bool
+
+val remove: ('a, 'id) t -> 'a -> unit
+
+val forEachU: ('a, 'id) t -> ('a  -> unit [@bs]) ->  unit
+val forEach: ('a, 'id) t -> ('a  -> unit) ->  unit
+(** Order unspecified. *)
+
+val reduceU: ('a, 'id) t -> 'c -> ('c -> 'a  ->  'c [@bs]) -> 'c
+val reduce: ('a, 'id) t -> 'c -> ('c -> 'a  ->  'c) -> 'c
+(** Order unspecified. *)
+
+val size: ('a, 'id) t -> int
+
+val logStats: _ t -> unit
+
+val toArray: ('a,'id) t -> 'a array
+
+val fromArray: 'a array -> id:('a,'id) id -> ('a,'id) t
+
+val mergeMany: ('a,'id) t -> 'a array -> unit
+
+val getBucketHistogram: _ t -> int array
+
+