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

package/lib/ocaml/belt_internalAVLtree.mli

@@ -0,0 +1,215 @@
+(* 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. *)
+
+
+
+type ('key, 'a) t = ('key, 'a) node option
+
+and ('k,  'v) node  =  {
+  mutable key : 'k;  [@bs.as "k"]
+  mutable value : 'v;  [@bs.as "v"]
+  mutable height : int;  [@bs.as "h"]
+  mutable left : ('k,'v) t; [@bs.as "l"]
+  mutable right : ('k,'v) t [@bs.as "r"]
+} 
+
+
+type ('k, 'id) cmp = ('k, 'id) Belt_Id.cmp
+
+val copy : ('k, 'v) t -> ('k, 'v) t
+val create :
+  ('a,'b) t -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
+val bal :
+  ('a,'b) t -> 'a -> 'b -> ('a,'b) t -> ('a,'b) t
+
+val singleton : 'a -> 'b -> ('a,'b) t
+
+val updateValue : ('k, 'v) node -> 'v -> ('k,'v) node
+
+val minKey: ('a, 'b) t -> 'a option 
+val minKeyUndefined: ('a, 'b) t -> 'a Js.undefined
+
+val maxKey : ('a, 'b) t -> 'a option 
+val maxKeyUndefined : ('a, 'b) t -> 'a Js.undefined
+
+val minimum : ('a, 'b) t -> ('a * 'b) option
+val minUndefined : ('a,'b) t -> ('a * 'b) Js.undefined
+
+val maximum : ('a,'b) t -> ('a * 'b) option
+val maxUndefined : ('a,'b) t -> ('a * 'b) Js.undefined
+
+val removeMinAuxWithRef : ('a, 'b) node -> 'a ref -> 'b ref -> ('a,'b) t
+
+
+val isEmpty : _ t -> bool
+
+val stackAllLeft :
+  ('a,'b) t -> ('a, 'b) node list -> ('a, 'b) node list
+
+val findFirstByU : ('a, 'b) t -> ('a -> 'b -> bool [@bs]) -> ('a * 'b) option
+val findFirstBy : ('a, 'b) t -> ('a -> 'b -> bool ) -> ('a * 'b) option
+
+val forEachU:  ('a,'b) t -> ('a -> 'b -> unit [@bs]) -> unit
+val forEach:  ('a,'b) t -> ('a -> 'b -> unit) -> unit
+
+val mapU:  ('c, 'a) t -> ('a -> 'b [@bs]) -> ('c, 'b) t
+val map:  ('c, 'a) t -> ('a -> 'b) -> ('c, 'b) t    
+
+val mapWithKeyU: ('a,'b) t -> ('a -> 'b -> 'c [@bs]) -> ('a, 'c) t
+val mapWithKey: ('a,'b) t -> ('a -> 'b -> 'c) -> ('a, 'c) t
+
+val reduceU: ('a,'b) t -> 'c -> ( 'c -> 'a -> 'b -> 'c [@bs]) ->  'c
+val reduce: ('a,'b) t -> 'c -> ( 'c -> 'a -> 'b -> 'c ) ->  'c
+
+val everyU:  ('a,'b) t -> ('a -> 'b -> bool [@bs]) -> bool
+val every:  ('a,'b) t -> ('a -> 'b -> bool) -> bool
+
+val someU:  ('a,'b) t -> ('a -> 'b -> bool [@bs]) -> bool
+val some:  ('a,'b) t -> ('a -> 'b -> bool) -> bool  
+
+val join: ('a,'b) t -> 'a -> 'b -> ('a,'b) t -> ('a, 'b) t
+
+val concat: ('a,'b) t -> ('a,'b) t -> ('a,'b) t
+
+val concatOrJoin:
+  ('a,'b) t -> 'a -> 'b option -> ('a,'b) t -> ('a, 'b) t
+
+val keepSharedU: 
+  ('a,'b) t ->
+  ('a -> 'b -> bool [@bs]) -> 
+  ('a,'b) t
+val keepShared: 
+  ('a,'b) t ->
+  ('a -> 'b -> bool) -> 
+  ('a,'b) t
+
+val keepMapU:    
+  ('a, 'b) t -> 
+  ('a -> 'b -> 'c option [@bs]) -> 
+  ('a, 'c) t
+val keepMap:    
+  ('a, 'b) t -> 
+  ('a -> 'b -> 'c option ) -> 
+  ('a, 'c) t
+
+(* seems no sharing, could be shared with mutation *)
+val partitionSharedU:  
+  ('a,'b) t -> 
+  ('a -> 'b -> bool [@bs]) ->
+  ('a,'b) t * ('a,'b) t
+val partitionShared:  
+  ('a,'b) t -> 
+  ('a -> 'b -> bool ) ->
+  ('a,'b) t * ('a,'b) t
+
+
+val lengthNode : ('a, 'b) node -> int
+val size : ('a,'b) t -> int
+
+val toList : ('a,'b) t -> ('a * 'b) list
+val checkInvariantInternal : ('a,'b) t -> unit
+(**
+  **raise** when invariant is not held
+*)  
+
+
+val fillArray : ('a,'b) node -> int -> ('a * 'b) array -> int  
+
+val toArray : ('a, 'b) t -> ('a * 'b) array  
+val keysToArray : ('a, 'b) t -> 'a array
+val valuesToArray : ('a, 'b) t -> 'b array 
+val fromSortedArrayAux : ('a * 'b) array -> int -> int -> ('a, 'b) t
+val fromSortedArrayRevAux : ('a * 'b) array -> int -> int -> ('a, 'b) t
+val fromSortedArrayUnsafe : ('a * 'b) array -> ('a, 'b) t
+
+val cmpU: 
+  ('a, 'b) t -> ('a, 'c) t -> 
+  kcmp:('a,_) cmp -> 
+  vcmp :('b -> 'c -> int [@bs]) -> 
+  int 
+val cmp: 
+  ('a, 'b) t -> ('a, 'c) t -> 
+  kcmp:('a,_) cmp -> 
+  vcmp :('b -> 'c -> int) -> 
+  int 
+
+
+
+val eqU:   
+  ('a, 'b) t -> ('a, 'c) t -> 
+  kcmp:('a,_) cmp -> 
+  veq:('b -> 'c -> bool [@bs]) -> 
+  bool
+val eq:   
+  ('a, 'b) t -> ('a, 'c) t -> 
+  kcmp:('a,_) cmp -> 
+  veq:('b -> 'c -> bool) -> 
+  bool
+
+val get:  
+  ('a, 'b) t -> 
+  'a -> 
+  cmp:('a,_) cmp -> 
+  'b option 
+
+val getUndefined:  
+  ('a, 'b) t -> 
+  'a -> 
+  cmp:('a,_) cmp -> 
+  'b Js.undefined
+
+val getWithDefault:  
+  ('a, 'b) t -> 
+  'a -> 
+  'b -> 
+  cmp:('a,_) cmp -> 
+  'b 
+val getExn:  
+  ('a, 'b) t -> 
+  'a -> 
+  cmp:('a,_) cmp ->   
+  'b 
+
+val has:  
+  ('a, 'b) t -> 
+  'a -> 
+  cmp:('a,_) cmp -> 
+  bool
+
+
+
+val fromArray : ('a * 'b) array ->  cmp:('a,'id) cmp -> ('a, 'b) t
+
+val updateMutate :   
+  ('a, 'b) t -> 'a -> 'b -> 
+  cmp:('a,'id) cmp -> 
+  ('a, 'b) t
+
+val balMutate :   
+  ('a, 'b) node -> ('a, 'b) node 
+
+val removeMinAuxWithRootMutate :   
+  ('a, 'b) node -> 
+  ('a, 'b) node -> 
+  ('a, 'b) t 

package/lib/ocaml/belt_internalBuckets.ml

@@ -0,0 +1,218 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                                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                           *)
+
+(* For JS backends, we use `undefined` as default value, so that buckets
+   could be allocated lazily
+*)
+
+(* We do dynamic hashing, and resize the table and rehash the elements
+   when buckets become too long. *)
+module C = Belt_internalBucketsType
+(* TODO:
+   the current implementation relies on the fact that bucket 
+   empty value is `undefined` in both places,
+   in theory, it can be different 
+
+*)
+type ('a,'b) bucket = {
+  mutable key : 'a;
+  mutable value : 'b;
+  mutable next : ('a,'b) bucket C.opt
+}  
+and ('hash, 'eq, 'a, 'b) t = ('hash, 'eq, ('a,'b) bucket) C.container  
+
+
+module A = Belt_Array
+
+
+let rec copy ( x : _ t) : _ t= 
+  {
+    hash = x.hash;
+    eq = x.eq;
+    size = x.size;
+    buckets = copyBuckets x.buckets
+  }
+and copyBuckets ( buckets : _ bucket C.opt array) =  
+  let len = A.length buckets in 
+  let newBuckets = A.makeUninitializedUnsafe len in 
+  for i = 0 to len - 1 do 
+    A.setUnsafe newBuckets i 
+    (copyBucket (A.getUnsafe buckets i))
+  done ;
+  newBuckets
+and copyBucket c =   
+  match C.toOpt c with 
+  | None -> c 
+  | Some c -> 
+    let head = {key = c.key ; value = c.value;
+                  next = (C.emptyOpt)} in 
+    copyAuxCont c.next head;
+    C.return head
+and copyAuxCont c prec =       
+  match C.toOpt c with 
+  | None -> ()
+  | Some nc -> 
+    let ncopy = 
+        {key = nc.key;  value = nc.value; next = C.emptyOpt} in 
+    prec.next <- (C.return ncopy) ;
+    copyAuxCont nc.next ncopy
+
+
+
+
+let rec bucketLength accu buckets = 
+  match C.toOpt buckets with 
+  | None -> accu
+  | Some cell -> bucketLength (accu + 1) cell.next
+
+
+
+let rec do_bucket_iter ~f buckets = 
+  match C.toOpt buckets with 
+  | None ->
+    ()
+  | Some cell ->
+    f cell.key  cell.value [@bs] |. ignore ; do_bucket_iter ~f cell.next
+
+let forEachU h f =
+  let d = h.C.buckets in
+  for i = 0 to A.length d - 1 do
+    do_bucket_iter ~f (A.getUnsafe d i)
+  done
+
+let forEach h f = forEachU h (fun [@bs] a b -> f a b)
+    
+let rec do_bucket_fold ~f b accu =
+  match C.toOpt b with
+  | None ->
+    accu
+  | Some cell ->
+    do_bucket_fold ~f cell.next (f accu cell.key cell.value  [@bs]) 
+
+let reduceU  h init f =
+  let d =h.C.buckets in
+  let accu = ref init in
+  for i = 0 to A.length d - 1 do
+    accu .contents<- do_bucket_fold ~f (A.getUnsafe d i) accu.contents
+  done;
+  accu.contents
+
+let reduce h init f = reduceU h init (fun [@bs] a b c -> f a b c)
+
+
+let getMaxBucketLength h =
+  A.reduceU h.C.buckets 0
+    (fun[@bs] m b -> 
+       let len = bucketLength 0 b in
+       Pervasives.max m len)
+
+let getBucketHistogram h =
+  let mbl = getMaxBucketLength h in 
+  let histo = A.makeByU (mbl + 1) (fun[@bs] _ -> 0) in
+  A.forEachU h.C.buckets
+    (fun[@bs] b ->
+       let l = bucketLength 0 b in
+       A.setUnsafe histo l (A.getUnsafe histo l + 1)
+    );
+  histo
+
+let logStats h =
+  let histogram = getBucketHistogram h in 
+  Js.log [%obj{ bindings = h.C.size;
+                buckets = A.length h.C.buckets;
+                histogram}]
+
+
+(** iterate the Buckets, in place remove the elements *)                
+let rec filterMapInplaceBucket f h i prec cell =
+  let n = cell.next in
+  begin match f cell.key cell.value [@bs] with
+    | None ->
+      h.C.size <- (h.C.size- 1); (* delete *)
+      begin match C.toOpt n with 
+        | Some nextCell -> 
+          filterMapInplaceBucket f h i prec nextCell
+        | None -> 
+          match C.toOpt prec with 
+          | None -> A.setUnsafe h.C.buckets i prec
+          | Some cell -> cell.next <- n
+      end
+    | Some data -> (* replace *)
+      let bucket = C.return cell in 
+      begin match C.toOpt prec with
+        | None -> A.setUnsafe h.C.buckets i  bucket 
+        | Some _ -> cell.next <- bucket
+      end;
+      cell.value <- data;
+      match C.toOpt n with 
+      | None -> cell.next <- n 
+      | Some nextCell -> 
+        filterMapInplaceBucket f h i bucket nextCell
+  end
+
+let keepMapInPlaceU h f =
+  let h_buckets = h.C.buckets in
+  for i = 0 to A.length h_buckets - 1 do
+    let v = A.getUnsafe h_buckets i in 
+    match C.toOpt v with 
+    | None -> ()
+    | Some v -> filterMapInplaceBucket f h i C.emptyOpt v
+  done
+
+let keepMapInPlace h f = keepMapInPlaceU h (fun [@bs] a b -> f a b)
+    
+let rec fillArray i arr cell =  
+  A.setUnsafe arr i (cell.key, cell.value);
+  match C.toOpt cell.next with 
+  | None -> i + 1
+  | Some v -> fillArray (i + 1) arr v 
+
+(* let toArray h = 
+  let d =h.bucketsin 
+  let current = ref 0 in 
+  let arr = A.makeUninitializedUnsafe (C.sizeGet h) in 
+  for i = 0 to A.length d - 1 do  
+    let cell = A.getUnsafe d i in 
+    match C.toOpt cell with 
+    | None -> ()
+    | Some cell -> 
+      current .contents<- fillArray current.contents arr cell
+  done;
+  arr  *)
+
+let rec fillArrayMap i arr cell f =  
+  A.setUnsafe arr i (f cell [@bs]);
+  match C.toOpt cell.next with 
+  | None -> i + 1
+  | Some v -> fillArrayMap (i + 1) arr v f
+
+let linear h f = 
+  let d = h.C.buckets in 
+  let current = ref 0 in 
+  let arr = A.makeUninitializedUnsafe h.C.size in 
+  for i = 0 to A.length d - 1 do  
+    let cell = A.getUnsafe d i in 
+    match C.toOpt cell with 
+    | None -> ()
+    | Some cell -> 
+      current .contents<- fillArrayMap current.contents arr cell f
+  done;
+  arr 
+
+let keysToArray h = linear h (fun [@bs] x -> x.key)  
+let valuesToArray h = linear h (fun [@bs] x -> x.value)  
+let toArray h = linear h (fun [@bs]x -> x.key, x.value)
+
+
+

package/lib/ocaml/belt_internalBuckets.mli

@@ -0,0 +1,57 @@
+(* 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 C = Belt_internalBucketsType
+
+type ('a,'b) bucket = {
+  mutable key : 'a;
+  mutable value : 'b;
+  mutable next : ('a,'b) bucket C.opt
+}  
+and ('hash, 'eq, 'a, 'b) t = ('hash, 'eq, ('a,'b) bucket) C.container  
+
+
+val copy : ('hash, 'eq, 'a, 'b) t -> ('hash, 'eq, 'a, 'b) t
+
+val forEachU: (_, _, 'a, 'b) t -> ('a -> 'b -> 'c [@bs]) -> unit
+val forEach: (_, _, 'a, 'b) t -> ('a -> 'b -> 'c) -> unit
+
+val reduceU: (_, _, 'a, 'b) t -> 'c -> ('c -> 'a -> 'b -> 'c [@bs]) -> 'c
+val reduce: (_, _, 'a, 'b) t -> 'c -> ('c -> 'a -> 'b -> 'c) -> 'c  
+
+val logStats : _ t -> unit
+
+
+val keepMapInPlaceU: (_, _, 'a, 'b) t -> ('a -> 'b -> 'b option [@bs]) -> unit
+val keepMapInPlace: (_, _, 'a, 'b) t -> ('a -> 'b -> 'b option) -> unit
+
+val fillArray : int -> ('a * 'b) array -> ('a, 'b) bucket -> int
+
+val keysToArray : (_, _, 'a, _) t -> 'a array
+
+val valuesToArray : (_, _, _, 'b) t -> 'b array
+
+val toArray : (_, _, 'a, 'b) t -> ('a * 'b) array
+
+val getBucketHistogram : _ t -> int array

package/lib/ocaml/belt_internalBucketsType.ml

@@ -0,0 +1,59 @@
+(* 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. *)
+type 'a opt = 'a Js.undefined
+
+type ('hash, 'eq, 'c) container =
+  { mutable size: int;                        (* number of entries *)
+    mutable buckets: 'c opt array;  (* the buckets *)
+    hash: 'hash;
+    eq: 'eq
+  }
+
+
+module A = Belt_Array
+external toOpt : 'a opt -> 'a option = "#undefined_to_opt"
+external return : 'a -> 'a opt = "%identity" 
+
+let emptyOpt = Js.undefined   
+let rec power_2_above x n =
+  if x >= n then x
+  else if x * 2 < x then x (* overflow *)
+  else power_2_above (x * 2) n
+
+let make  ~hash ~eq ~hintSize =
+  let s = power_2_above 16 hintSize in  
+  { size = 0;
+    buckets = A.makeUninitialized s;
+    hash;
+    eq }
+
+let clear h =
+  h.size <- 0;
+  let h_buckets = h.buckets in 
+  let len = A.length h_buckets in
+  for i = 0 to len - 1 do
+    A.setUnsafe h_buckets i  emptyOpt
+  done
+
+let isEmpty h = h.size = 0 

package/lib/ocaml/belt_internalBucketsType.mli

@@ -0,0 +1,46 @@
+(* 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. *)
+
+type 'a opt = 'a Js.undefined
+type ('hash, 'eq, 'c) container =
+  { 
+    mutable size: int;                        (* number of entries *)
+    mutable buckets: 'c opt array;  (* the buckets *)
+    hash: 'hash;
+    eq: 'eq;
+  } 
+
+external toOpt : 'a opt -> 'a option = "#undefined_to_opt"
+external return : 'a -> 'a opt = "%identity"
+
+val emptyOpt : 'a Js.undefined
+val make :
+  hash:'hash ->
+  eq:'eq -> 
+  hintSize:int ->
+  ('hash, 'eq, _) container
+
+val clear : _ container -> unit
+
+val isEmpty: _ container -> bool