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

package/lib/ocaml/belt_internalMapInt.ml

@@ -0,0 +1,227 @@
+# 1 "others/internal_map.cppo.ml"
+[@@@bs.config {flags = [| "-bs-noassertfalse" |]}]
+# 5 "others/internal_map.cppo.ml"
+type key = int
+
+# 10 "others/internal_map.cppo.ml"
+module N = Belt_internalAVLtree
+module A = Belt_Array 
+module S = Belt_SortArray
+
+
+
+type  'a t = (key,'a) N.t
+
+let rec add  t (x : key) (data : _)  = 
+  match t with
+  | None -> 
+    N.singleton x data 
+  | Some n  ->
+    let k = n.N.key in 
+    if x = k then
+      Some (N.updateValue n data)
+    else
+      let v = n.N.value  in 
+      if x < k then
+        N.bal (add n.N.left x data ) k v n.N.right
+      else
+        N.bal n.N.left k v (add n.N.right x data )
+
+let rec get n (x : key)  =
+  match n with 
+    None -> None
+  | Some n  ->
+    let v = n.N.key in 
+    if x = v then Some n.N.value
+    else get (if x < v then n.N.left else n.N.right) x 
+
+let rec getUndefined n (x : key) = 
+  match n with 
+  | None ->
+    Js.undefined
+  | Some n  ->
+    let v = n.N.key in 
+    if x = v then Js.Undefined.return n.N.value
+    else getUndefined (if x < v then n.N.left else n.N.right) x 
+
+let rec getExn n (x : key) =
+  match n with 
+  | None -> raise Not_found
+  | Some n -> 
+    let v = n.N.key in 
+    if x = v then n.N.value
+    else getExn (if x < v then n.N.left else n.N.right) x
+
+let rec getWithDefault n (x : key) def =
+  match n with 
+  | None -> def    
+  | Some n -> 
+    let v = n.N.key in 
+    if x = v then n.N.value
+    else getWithDefault (if x < v then n.N.left else n.N.right) x def
+    
+let rec has n (x : key)= 
+  match n with 
+    None -> false
+  | Some n (* Node(l, v, d, r, _) *) ->
+    let v = n.N.key in 
+    x = v || has (if x < v then n.N.left else n.N.right) x 
+
+let rec remove n (x : key) = 
+  match n with 
+  |  None -> n    
+  |  Some n ->
+    let {N.left = l; key = v; right = r} = n in 
+    if x = v then
+      match l, r with
+      | None, _ -> r 
+      | _, None -> l 
+      | _, Some rn -> 
+        let kr, vr = ref rn.key, ref rn.value in 
+        let r = N.removeMinAuxWithRef rn kr vr in 
+        N.bal l kr.contents vr.contents r 
+    else if x < v then
+      N.(bal (remove l x ) v n.value r)
+    else
+      N.(bal l v n.value (remove r x ))
+
+let rec splitAux (x : key) (n : _ N.node) : _ t * _ option  * _ t =  
+  let {N.left = l; key = v; value = d; right = r} = n in  
+  if x = v then (l, Some d, r)
+  else     
+  if x < v then
+    match l with 
+    | None -> 
+      None, None, Some n
+    | Some l -> 
+      let (ll, pres, rl) = splitAux x l in (ll, pres, N.join rl v d r)
+  else
+    match r with 
+    | None ->
+      Some n, None, None
+    | Some r -> 
+      let (lr, pres, rr) = splitAux x r in (N.join l v d lr, pres, rr)
+
+
+let split (x : key) n =
+  match n with 
+    None ->
+    None, None, None
+  | Some n -> 
+    splitAux x n 
+
+let rec mergeU s1 s2 f =
+  match s1, s2 with
+    (None, None) -> None
+  | Some n (* (Node (l1, v1, d1, r1, h1), _)*), _ 
+    when (n.N.height >= (match s2 with None -> 0 | Some n -> n.N.height)) ->
+    let {N.left = l1; key = v1; value = d1; right = r1} = n in 
+    let (l2, d2, r2) = split v1 s2 in
+    N.concatOrJoin (mergeU l1 l2 f) v1 (f v1 (Some d1) d2 [@bs]) (mergeU r1 r2 f)
+  | (_, Some n) (* Node (l2, v2, d2, r2, h2) *)  ->
+    let {N.left = l2; key = v2; value = d2; right = r2} = n in 
+    let (l1, d1, r1) = split v2 s1 in
+    N.concatOrJoin (mergeU l1 l2 f) v2 (f v2 d1 (Some d2) [@bs]) (mergeU r1 r2 f)
+  | _ ->
+    assert false
+
+let merge s1 s2 f = mergeU s1 s2 (fun [@bs] a b c -> f a b c)
+    
+let rec compareAux e1 e2 vcmp =
+  match e1,e2 with 
+  | h1::t1, h2::t2 ->
+    let c = Pervasives.compare (h1.N.key : key) h2.N.key  in 
+    if c = 0 then 
+      let cx = vcmp h1.N.value h2.N.value [@bs] in 
+      if cx = 0 then
+        compareAux 
+          (N.stackAllLeft  h1.N.right t1 ) 
+          (N.stackAllLeft h2.N.right t2)
+          vcmp 
+      else  cx
+    else c 
+  | _, _ -> 0    
+
+let cmpU s1 s2 cmp = 
+  let len1, len2 = N.size s1, N.size s2 in 
+  if len1 = len2 then 
+    compareAux 
+      (N.stackAllLeft s1 []) 
+      (N.stackAllLeft s2 []) 
+      cmp 
+  else if len1 < len2 then -1 
+  else 1 
+
+let cmp s1 s2 f = cmpU s1 s2 (fun[@bs] a b -> f a b)
+
+let rec eqAux e1 e2  eq =
+  match e1,e2 with 
+  | h1::t1, h2::t2 ->
+    if (h1.N.key : key) =  h2.N.key  && 
+       eq h1.N.value h2.N.value [@bs] then
+      eqAux (
+        N.stackAllLeft  h1.N.right t1 ) 
+        (N.stackAllLeft h2.N.right t2)
+        eq
+    else  false    
+  | _, _ -> true (*end *)  
+
+let eqU s1 s2 eq =      
+  let len1,len2 = N.size s1, N.size s2 in 
+  if len1 = len2 then 
+    eqAux 
+      (N.stackAllLeft s1 [])
+      (N.stackAllLeft s2 []) eq 
+  else false  
+
+let eq s1 s2 f = eqU s1 s2 (fun[@bs] a b -> f a b)
+    
+let rec addMutate  (t : _ t) x data : _ t =   
+  match t with 
+  | None -> N.singleton x data
+  | Some nt -> 
+    let k = nt.N.key in 
+    (* let  c = (Belt_Cmp.getCmpInternal cmp) x k [@bs] in   *)
+    if x = k then begin     
+      nt.N.key <- x;
+      nt.value <- data;
+      Some nt
+    end      
+    else
+      let l, r = (nt.N.left, nt.N.right) in 
+      (if x < k then                   
+         let ll = addMutate  l x data in
+         nt.left <- ll
+       else   
+         nt.right <- (addMutate r x data);
+      );
+      Some (N.balMutate nt)  
+
+let fromArray (xs : (key * _) array) =   
+  let len = A.length xs in 
+  if len = 0 then None
+  else
+    let next = 
+        ref (S.strictlySortedLengthU xs 
+        (fun[@bs] (x0,_) (y0,_) -> 
+            x0 < y0
+        ))
+      in 
+    let result  = ref (
+      if next.contents >= 0 then 
+        N.fromSortedArrayAux xs 0 next.contents 
+      else begin   
+        next .contents<- - next.contents; 
+        N.fromSortedArrayRevAux xs (next.contents - 1) (next.contents)
+      end  
+    ) in 
+    for i = next.contents to len - 1 do 
+      let k, v = (A.getUnsafe xs i)  in 
+      result .contents<- addMutate  result.contents k v 
+    done ;
+    result.contents         
+
+
+
+
+

package/lib/ocaml/belt_internalMapString.ml

@@ -0,0 +1,227 @@
+# 1 "others/internal_map.cppo.ml"
+[@@@bs.config {flags = [| "-bs-noassertfalse" |]}]
+# 3 "others/internal_map.cppo.ml"
+type key = string
+
+# 10 "others/internal_map.cppo.ml"
+module N = Belt_internalAVLtree
+module A = Belt_Array 
+module S = Belt_SortArray
+
+
+
+type  'a t = (key,'a) N.t
+
+let rec add  t (x : key) (data : _)  = 
+  match t with
+  | None -> 
+    N.singleton x data 
+  | Some n  ->
+    let k = n.N.key in 
+    if x = k then
+      Some (N.updateValue n data)
+    else
+      let v = n.N.value  in 
+      if x < k then
+        N.bal (add n.N.left x data ) k v n.N.right
+      else
+        N.bal n.N.left k v (add n.N.right x data )
+
+let rec get n (x : key)  =
+  match n with 
+    None -> None
+  | Some n  ->
+    let v = n.N.key in 
+    if x = v then Some n.N.value
+    else get (if x < v then n.N.left else n.N.right) x 
+
+let rec getUndefined n (x : key) = 
+  match n with 
+  | None ->
+    Js.undefined
+  | Some n  ->
+    let v = n.N.key in 
+    if x = v then Js.Undefined.return n.N.value
+    else getUndefined (if x < v then n.N.left else n.N.right) x 
+
+let rec getExn n (x : key) =
+  match n with 
+  | None -> raise Not_found
+  | Some n -> 
+    let v = n.N.key in 
+    if x = v then n.N.value
+    else getExn (if x < v then n.N.left else n.N.right) x
+
+let rec getWithDefault n (x : key) def =
+  match n with 
+  | None -> def    
+  | Some n -> 
+    let v = n.N.key in 
+    if x = v then n.N.value
+    else getWithDefault (if x < v then n.N.left else n.N.right) x def
+    
+let rec has n (x : key)= 
+  match n with 
+    None -> false
+  | Some n (* Node(l, v, d, r, _) *) ->
+    let v = n.N.key in 
+    x = v || has (if x < v then n.N.left else n.N.right) x 
+
+let rec remove n (x : key) = 
+  match n with 
+  |  None -> n    
+  |  Some n ->
+    let {N.left = l; key = v; right = r} = n in 
+    if x = v then
+      match l, r with
+      | None, _ -> r 
+      | _, None -> l 
+      | _, Some rn -> 
+        let kr, vr = ref rn.key, ref rn.value in 
+        let r = N.removeMinAuxWithRef rn kr vr in 
+        N.bal l kr.contents vr.contents r 
+    else if x < v then
+      N.(bal (remove l x ) v n.value r)
+    else
+      N.(bal l v n.value (remove r x ))
+
+let rec splitAux (x : key) (n : _ N.node) : _ t * _ option  * _ t =  
+  let {N.left = l; key = v; value = d; right = r} = n in  
+  if x = v then (l, Some d, r)
+  else     
+  if x < v then
+    match l with 
+    | None -> 
+      None, None, Some n
+    | Some l -> 
+      let (ll, pres, rl) = splitAux x l in (ll, pres, N.join rl v d r)
+  else
+    match r with 
+    | None ->
+      Some n, None, None
+    | Some r -> 
+      let (lr, pres, rr) = splitAux x r in (N.join l v d lr, pres, rr)
+
+
+let split (x : key) n =
+  match n with 
+    None ->
+    None, None, None
+  | Some n -> 
+    splitAux x n 
+
+let rec mergeU s1 s2 f =
+  match s1, s2 with
+    (None, None) -> None
+  | Some n (* (Node (l1, v1, d1, r1, h1), _)*), _ 
+    when (n.N.height >= (match s2 with None -> 0 | Some n -> n.N.height)) ->
+    let {N.left = l1; key = v1; value = d1; right = r1} = n in 
+    let (l2, d2, r2) = split v1 s2 in
+    N.concatOrJoin (mergeU l1 l2 f) v1 (f v1 (Some d1) d2 [@bs]) (mergeU r1 r2 f)
+  | (_, Some n) (* Node (l2, v2, d2, r2, h2) *)  ->
+    let {N.left = l2; key = v2; value = d2; right = r2} = n in 
+    let (l1, d1, r1) = split v2 s1 in
+    N.concatOrJoin (mergeU l1 l2 f) v2 (f v2 d1 (Some d2) [@bs]) (mergeU r1 r2 f)
+  | _ ->
+    assert false
+
+let merge s1 s2 f = mergeU s1 s2 (fun [@bs] a b c -> f a b c)
+    
+let rec compareAux e1 e2 vcmp =
+  match e1,e2 with 
+  | h1::t1, h2::t2 ->
+    let c = Pervasives.compare (h1.N.key : key) h2.N.key  in 
+    if c = 0 then 
+      let cx = vcmp h1.N.value h2.N.value [@bs] in 
+      if cx = 0 then
+        compareAux 
+          (N.stackAllLeft  h1.N.right t1 ) 
+          (N.stackAllLeft h2.N.right t2)
+          vcmp 
+      else  cx
+    else c 
+  | _, _ -> 0    
+
+let cmpU s1 s2 cmp = 
+  let len1, len2 = N.size s1, N.size s2 in 
+  if len1 = len2 then 
+    compareAux 
+      (N.stackAllLeft s1 []) 
+      (N.stackAllLeft s2 []) 
+      cmp 
+  else if len1 < len2 then -1 
+  else 1 
+
+let cmp s1 s2 f = cmpU s1 s2 (fun[@bs] a b -> f a b)
+
+let rec eqAux e1 e2  eq =
+  match e1,e2 with 
+  | h1::t1, h2::t2 ->
+    if (h1.N.key : key) =  h2.N.key  && 
+       eq h1.N.value h2.N.value [@bs] then
+      eqAux (
+        N.stackAllLeft  h1.N.right t1 ) 
+        (N.stackAllLeft h2.N.right t2)
+        eq
+    else  false    
+  | _, _ -> true (*end *)  
+
+let eqU s1 s2 eq =      
+  let len1,len2 = N.size s1, N.size s2 in 
+  if len1 = len2 then 
+    eqAux 
+      (N.stackAllLeft s1 [])
+      (N.stackAllLeft s2 []) eq 
+  else false  
+
+let eq s1 s2 f = eqU s1 s2 (fun[@bs] a b -> f a b)
+    
+let rec addMutate  (t : _ t) x data : _ t =   
+  match t with 
+  | None -> N.singleton x data
+  | Some nt -> 
+    let k = nt.N.key in 
+    (* let  c = (Belt_Cmp.getCmpInternal cmp) x k [@bs] in   *)
+    if x = k then begin     
+      nt.N.key <- x;
+      nt.value <- data;
+      Some nt
+    end      
+    else
+      let l, r = (nt.N.left, nt.N.right) in 
+      (if x < k then                   
+         let ll = addMutate  l x data in
+         nt.left <- ll
+       else   
+         nt.right <- (addMutate r x data);
+      );
+      Some (N.balMutate nt)  
+
+let fromArray (xs : (key * _) array) =   
+  let len = A.length xs in 
+  if len = 0 then None
+  else
+    let next = 
+        ref (S.strictlySortedLengthU xs 
+        (fun[@bs] (x0,_) (y0,_) -> 
+            x0 < y0
+        ))
+      in 
+    let result  = ref (
+      if next.contents >= 0 then 
+        N.fromSortedArrayAux xs 0 next.contents 
+      else begin   
+        next .contents<- - next.contents; 
+        N.fromSortedArrayRevAux xs (next.contents - 1) (next.contents)
+      end  
+    ) in 
+    for i = next.contents to len - 1 do 
+      let k, v = (A.getUnsafe xs i)  in 
+      result .contents<- addMutate  result.contents k v 
+    done ;
+    result.contents         
+
+
+
+
+

package/lib/ocaml/belt_internalSetBuckets.ml

@@ -0,0 +1,157 @@
+(* 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. *)
+
+(* 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 bucket = {
+  mutable key : 'a;
+  mutable next : 'a bucket C.opt
+}  
+and ('hash, 'eq, 'a) t = ('hash, 'eq, 'a 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 ;
+                  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;  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 doBucketIter ~f buckets = 
+  match C.toOpt buckets with 
+  | None ->
+    ()
+  | Some cell ->
+    f cell.key  [@bs]; doBucketIter ~f cell.next
+
+let forEachU h f =
+  let d = h.C.buckets  in
+  for i = 0 to A.length d - 1 do
+    doBucketIter ~f (A.getUnsafe d i)
+  done
+
+let forEach h f = forEachU h (fun[@bs] a -> f a )
+    
+let rec fillArray i arr cell =  
+  A.setUnsafe arr i cell.key;
+  match C.toOpt cell.next with 
+  | None -> i + 1
+  | Some v -> fillArray (i + 1) arr v 
+
+let toArray h = 
+  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<- fillArray current.contents arr cell
+  done;
+  arr 
+
+
+
+let rec doBucketFold ~f b accu =
+  match C.toOpt b with
+  | None ->
+    accu
+  | Some cell ->
+    doBucketFold ~f cell.next (f  accu cell.key [@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<- doBucketFold ~f (A.getUnsafe d i) accu.contents
+  done;
+  accu.contents
+
+let reduce h init f = reduceU h init (fun [@bs] a b -> f a b)
+    
+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  }]
+
+

package/lib/ocaml/belt_internalSetBuckets.mli

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