@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/belt_MutableQueue.ml

@@ -0,0 +1,222 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*         Francois Pottier, projet Cristal, INRIA Rocquencourt           *)
+(*                  Jeremie Dimino, Jane Street Europe                    *)
+(*                                                                        *)
+(*   Copyright 2002 Institut National de Recherche en Informatique et     *)
+(*     en Automatique.                                                    *)
+(*                                                                        *)
+(*   All rights reserved.  This file is distributed under the terms of    *)
+(*   the GNU Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+(* Adapted significantly by ReScript Authors                          *)
+module A = Belt_Array
+
+type 'a node = { 
+  content: 'a; 
+  mutable next: 'a cell 
+}
+and 'a cell = 'a node option 
+and 'a t = {
+  mutable length: int;
+  mutable first: 'a cell;
+  mutable last: 'a cell
+} 
+
+
+
+
+let make () =   
+    {
+      length = 0;
+      first = None;
+      last = None }
+
+
+let clear q =
+  q.length <-  0;
+  q.first <-  None;
+  q.last <-  None
+
+let add q x =
+  let cell = Some {
+      content = x;
+      next = None } in
+  match  q.last with
+  | None -> (* TODO: better names for intermediate var *)
+    q.length <- 1;
+    q.first <- cell;
+    q.last <- cell
+  | Some last ->
+    q.length <- q.length + 1;
+    last.next <-  cell;
+    q.last <-  cell
+
+
+  
+let peek q =
+  match  q.first with (* same here could be v *)
+  | None -> None
+  | Some v -> Some v.content
+
+let peekUndefined q =
+  match  q.first with
+  | None -> Js.undefined
+  | Some v -> Js.Undefined.return v.content
+
+
+let peekExn q =
+  match  q.first with
+  | None -> raise Not_found
+  | Some v -> v.content
+
+let pop q =
+  match  q.first with
+  | None -> None
+  | Some x  ->
+    let next = x.next in 
+    if next = None then 
+      begin (* only one element*)
+        clear q;
+        Some x.content
+      end
+    else begin 
+      q.length <- q.length  - 1;
+      q.first <- next;
+      Some x.content 
+    end
+
+let popExn q = (* TO fix *)
+  match  q.first with 
+  | None -> raise Not_found
+  | Some x  ->
+    let next = x.next in 
+    if next = None then 
+      begin (* only one element*)
+        clear q;
+        x.content
+      end
+    else begin 
+      q.length <- q.length - 1;
+      q.first <- next;
+      x.content 
+    end    
+
+let popUndefined q =
+  match  q.first with
+  | None -> Js.undefined
+  | Some x  ->
+    let next = x.next in 
+    if next = None then 
+      begin (* only one element*)
+        clear q;
+        Js.Undefined.return x.content
+      end
+    else begin 
+      q.length <- q.length - 1;
+      q.first <- next;
+      Js.Undefined.return x.content 
+    end
+
+let rec copyAux qRes prev cell =
+  match  cell with
+  | None -> qRes.last <-  prev; qRes
+  | Some x  ->
+    let content = x.content in 
+    let res =  Some {content ; next = None}  in
+    begin match  prev with
+      | None ->  qRes.first <- res
+      | Some p -> p.next <-  res
+    end;
+    copyAux qRes res (x.next)
+
+let copy q =
+  copyAux {length = q.length; first = None;  last = None}  None q.first
+
+
+      
+let rec copyMapAux qRes prev cell f =
+  match  cell with
+  | None ->  qRes.last <- prev; qRes
+  | Some x  ->
+    let content = f x.content [@bs] in 
+    let res = Some {content; next = None}  in
+    begin match  prev with (*TODO: optimize to remove such check*)
+      | None -> qRes.first <- res
+      | Some p -> p.next <-  res
+    end;
+    copyMapAux qRes res x.next f
+
+let mapU q f =
+  copyMapAux {length = q.length; first = None; last = None}  None q.first f
+    
+let map q f = mapU q (fun [@bs] a -> f a)
+    
+let isEmpty q =
+  q.length = 0
+
+let size q =
+  q.length
+
+let rec iterAux cell f =
+  match  cell with
+  | None -> ()
+  | Some x  ->
+    f x.content [@bs];
+    iterAux (x.next) f
+
+let forEachU q f =
+  iterAux q.first f
+
+let forEach q f = forEachU q (fun[@bs] a -> f a)
+    
+let rec foldAux f accu cell =
+  match  cell with
+  | None -> accu
+  | Some x  ->
+    let accu = f accu x.content [@bs] in
+    foldAux f accu (x.next)
+
+let reduceU q  accu f =
+  foldAux f accu q.first
+
+let reduce q accu f = reduceU q accu (fun[@bs] a b -> f a b)
+    
+let transfer q1 q2 =
+  if q1.length > 0 then
+    match  q2.last with
+    | None ->
+      q2.length <- q1.length;
+      q2.first <- q1.first;
+      q2.last <- q1.last;
+      clear q1
+    | Some l ->
+      q2.length <- (q2.length + q1.length);
+      l.next <- q1.first;
+      q2.last <- q1.last;
+      clear q1
+
+let rec fillAux i arr cell =       
+  match  cell with 
+  | None -> ()
+  | Some x ->
+    A.setUnsafe arr i x.content;
+    fillAux (i + 1) arr (x.next) 
+
+let toArray x =         
+  let v = A.makeUninitializedUnsafe x.length in 
+  fillAux 0 v x.first;
+  v
+
+(*TODO: optimize *)
+let fromArray arr =
+  let q = make () in
+  for i = 0 to A.length arr - 1 do
+    add q (A.getUnsafe arr i)
+  done ;
+  q
+

package/lib/ocaml/belt_MutableQueue.mli

@@ -0,0 +1,116 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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 Lesser General Public License version 2.1, with the          *)
+(*   special exception on linking described in the file LICENSE.          *)
+(*                                                                        *)
+(**************************************************************************)
+(* Adapted significantly by ReScript Authors *)
+
+(**
+  A FIFO (first in first out) queue data structure.
+*)
+
+type 'a t
+(**
+   The type of queues containing elements of `type('a)`.
+*)
+
+val make : unit -> 'a t
+(** 
+  Returns a new queue, initially empty.
+*)
+
+val clear : 'a t -> unit
+(**
+  Discard all elements from the queue.
+*)
+
+val isEmpty : 'a t -> bool
+(**
+  Returns `true` if the given queue is empty, `false` otherwise.
+*)
+
+val fromArray : 'a array -> 'a t
+(**
+  `fromArray` a is equivalent to `Array.forEach(a, add(q, a));`
+*)
+
+val add : 'a t -> 'a -> unit
+(**
+  `add(q, x)` adds the element `x` at the end of the queue `q`.
+*)
+
+val peek : 'a t -> 'a option
+(**
+  `peekOpt(q)` returns the first element in queue `q`, without removing it from the queue.
+*)
+
+val peekUndefined : 'a t -> 'a Js.undefined
+(**
+  `peekUndefined(q)` returns `undefined` if not found.
+*)
+
+val peekExn : 'a t -> 'a
+(**
+  raise an exception if `q` is empty
+*)
+
+val pop : 'a t -> 'a option
+(**
+  `pop(q)` removes and returns the first element in queue `q`.
+*)
+
+val popUndefined : 'a t -> 'a Js.undefined
+(**
+  `popUndefined(q)` removes and returns the first element in queue `q`. it will return `undefined` if it is already empty.
+*)
+
+val popExn : 'a t -> 'a
+(**
+  `popExn(q)` raise an exception if q is empty.
+*)
+
+val copy : 'a t -> 'a t
+(**
+  `copy(q)` returns a fresh queue.
+*)
+
+val size : 'a t -> int
+(**
+  Returns the number of elements in a queue.
+*)
+
+val mapU : 'a t -> (('a -> 'b)[@bs]) -> 'b t
+val map : 'a t -> ('a -> 'b) -> 'b t
+val forEachU : 'a t -> (('a -> unit)[@bs]) -> unit
+
+val forEach : 'a t -> ('a -> unit) -> unit
+(**
+  `forEach(q, f) applies`f`in turn to all elements of`q`, from the least
+  recently entered to the most recently entered. The queue itself is unchanged.
+*)
+
+val reduceU : 'a t -> 'b -> (('b -> 'a -> 'b)[@bs]) -> 'b
+
+val reduce : 'a t -> 'b -> ('b -> 'a -> 'b) -> 'b
+(**
+  `reduce(q, accu, f)` is equivalent to `List.reduce(l, accu, f)`, where `l` is the list of `q`'s elements. The queue remains unchanged.
+*)
+
+val transfer : 'a t -> 'a t -> unit
+(**
+  `transfer(q1, q2)` adds all of `q1`'s elements at the end of the queue `q2`, then clears `q1`. It is equivalent to the sequence `forEach((x) => add(x, q2), q1);`; clear `q1`, but runs in constant time.
+*)
+
+val toArray : 'a t -> 'a array
+(**
+  First added will be in the beginning of the array.
+*)

package/lib/ocaml/belt_MutableSet.ml

@@ -0,0 +1,371 @@
+
+(* 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_MutableSetInt
+module String = Belt_MutableSetString
+
+module N = Belt_internalAVLset
+module A = Belt_Array
+module Sort = Belt_SortArray
+
+
+type ('k, 'id) id = ('k, 'id) Belt_Id.comparable
+type ('key, 'id ) cmp = ('key, 'id) Belt_Id.cmp
+
+
+type ('value,'id) t =
+  {
+    cmp: ('value, 'id) cmp;
+    mutable data: 'value N.t
+  } 
+
+
+
+let rec remove0 nt x ~cmp = 
+  let k = nt.N.value in 
+  let c = cmp x k [@bs] in 
+  if c = 0 then 
+    let {N.left = l; right = r} = nt in       
+    match l, r with 
+    | None, _ -> r 
+    | _, None -> l 
+    | Some _,  Some nr ->  
+      nt.right <- (N.removeMinAuxWithRootMutate nt nr);
+      Some (N.balMutate nt)
+   else 
+    begin 
+      if c < 0 then 
+        match nt.left with         
+        | None -> Some nt 
+        | Some l ->
+          nt.left <- (remove0 ~cmp l x );
+          Some (N.balMutate nt)
+      else 
+        match nt.right with 
+        | None -> Some nt 
+        | Some r -> 
+          nt.right <- (remove0 ~cmp r x);
+          Some (N.balMutate nt)
+    end
+
+let remove  d  v =  
+  let oldRoot = d.data in 
+  match oldRoot with 
+  | None -> ()
+  | Some oldRoot2 ->
+    let newRoot = remove0 ~cmp:(Belt_Id.getCmpInternal d.cmp) oldRoot2 v in 
+    if newRoot != oldRoot then 
+      d.data <- newRoot    
+
+
+let rec removeMany0 t xs i len ~cmp  =  
+  if i < len then 
+    let ele = A.getUnsafe xs i in 
+    let u = remove0 t ele ~cmp in 
+    match u with 
+    | None -> None
+    | Some t -> removeMany0 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 
+    d.data <- 
+      (removeMany0 nt xs 0 len 
+        ~cmp:(Belt_Id.getCmpInternal d.cmp))
+
+
+let rec removeCheck0  nt x removed ~cmp= 
+  let k = nt.N.value in 
+  let c = (Belt_Id.getCmpInternal cmp) x k [@bs] in 
+  if c = 0 then 
+    let () = removed .contents<- true in  
+    let {N.left = l; right = r} = nt in       
+    match l, r with 
+    | None, _ -> r 
+    | _, None -> l  
+    | Some _,  Some nr ->  
+      nt.right <- (N.removeMinAuxWithRootMutate nt nr);
+      Some (N.balMutate nt)
+  else 
+    begin 
+      if c < 0 then 
+        match nt.left with         
+        | None -> Some nt 
+        | Some l ->
+          nt.left <- (removeCheck0 ~cmp l x removed);
+          Some (N.balMutate nt)
+      else 
+        match nt.right with 
+        | None -> Some nt 
+        | Some r -> 
+          nt.right <- (removeCheck0 ~cmp r x removed);
+          Some (N.balMutate nt)
+    end
+
+
+
+let removeCheck d v =  
+  let oldRoot = d.data in 
+  match oldRoot with 
+  | None -> false 
+  | Some oldRoot2 ->
+    let removed = ref false in 
+    let newRoot = removeCheck0 ~cmp:d.cmp oldRoot2 v removed in 
+    if newRoot != oldRoot then  
+      d.data <- newRoot ;   
+    removed.contents
+
+
+
+let rec addCheck0  t x added ~cmp  =   
+  match t with 
+  | None -> 
+    added .contents<- true;
+    N.singleton x 
+  | Some nt -> 
+    let k = nt.N.value in 
+    let c = cmp x k [@bs] in  
+    if c = 0 then t 
+    else
+      let {N.left = l; right = r} = nt in 
+      (if c < 0 then                   
+         let ll = addCheck0 ~cmp l x added in
+         nt.left <- ll
+       else   
+         nt.right <- (addCheck0 ~cmp r x added );
+      );
+      Some (N.balMutate nt)
+
+let addCheck m e = 
+  let oldRoot = m.data in 
+  let added = ref false in 
+  let newRoot = addCheck0 ~cmp:(Belt_Id.getCmpInternal m.cmp) oldRoot e added in 
+  if newRoot != oldRoot then 
+    m.data <- newRoot;
+  added.contents
+
+let add m e = 
+  let oldRoot = m.data  in 
+  let newRoot = N.addMutate ~cmp:m.cmp oldRoot e  in 
+  if newRoot != oldRoot then 
+    m.data <- newRoot
+
+let addArrayMutate t xs ~cmp =     
+  let v = ref t in 
+  for i = 0 to A.length xs - 1 do 
+    v .contents<- N.addMutate v.contents (A.getUnsafe xs i)  ~cmp
+  done; 
+  v.contents
+    
+let mergeMany d xs =   
+  d.data <- (addArrayMutate (d.data) xs ~cmp:d.cmp)
+
+
+let make (type value) (type identity) ~(id : (value, identity) id) =
+  let module M = (val id) in 
+  {cmp = M.cmp ; data = None}
+    
+let isEmpty d = 
+  N.isEmpty (d.data)
+    
+let minimum d = 
+  N.minimum (d.data)    
+let minUndefined d =
+  N.minUndefined (d.data)
+let maximum d = 
+  N.maximum (d.data)
+let maxUndefined d =
+  N.maxUndefined (d.data)
+
+let forEachU d f = N.forEachU (d.data) f
+let forEach d f = forEachU d (fun[@bs] a -> f a)
+let reduceU d acc cb = N.reduceU (d.data) acc cb
+let reduce d acc cb = reduceU d acc (fun[@bs] a b -> cb a b)    
+let everyU d p = N.everyU (d.data) p
+let every d p = everyU d (fun[@bs] a -> p a)    
+let someU d p = N.someU (d.data) p
+let some d p = someU d (fun[@bs] a -> p a)    
+let size d = 
+  N.size (d.data)
+let toList d =
+  N.toList (d.data)
+let toArray d = 
+  N.toArray (d.data)
+
+let fromSortedArrayUnsafe (type value) (type identity) xs ~(id : (value,identity) id) : _ t =
+  let module M = (val id) in 
+  {data = (N.fromSortedArrayUnsafe xs); cmp = M.cmp}
+
+let checkInvariantInternal d = 
+  N.checkInvariantInternal (d.data)
+    
+    
+let fromArray (type value) (type identity)  data ~(id : (value,identity) id) =
+  let module M = (val id) in
+  let cmp = M.cmp in 
+  {cmp; data = (N.fromArray ~cmp data)}
+
+
+let cmp d0 d1 = 
+  N.cmp ~cmp:(d0.cmp) (d0.data) (d1.data)
+
+let eq d0  d1 = 
+  N.eq ~cmp:(d0.cmp) (d0.data) (d1.data)
+    
+let get d x = 
+  N.get ~cmp:d.cmp d.data x
+    
+let getUndefined  d x = 
+  N.getUndefined ~cmp:d.cmp d.data x
+    
+let getExn d x = 
+  N.getExn ~cmp:d.cmp d.data x
+    
+
+let split d  key  =     
+  let arr = N.toArray d.data in
+  let cmp = d.cmp in 
+  let i = Sort.binarySearchByU arr key (Belt_Id.getCmpInternal cmp)  in   
+  let len = A.length arr in 
+  if i < 0 then 
+    let next = - i -1 in 
+    ({
+       data = (N.fromSortedArrayAux arr 0 next);
+       cmp}
+     ,      
+       {data = (N.fromSortedArrayAux arr next (len - next));
+        cmp}
+    ), false
+  else 
+    (
+       {data = (N.fromSortedArrayAux arr 0 i);
+        cmp},
+       { data = (N.fromSortedArrayAux arr (i+1) (len - i - 1));
+         cmp}
+     ), true       
+
+let keepU d p = 
+  {data = (N.keepCopyU d.data p );  cmp = d.cmp}
+
+let keep d p = keepU d (fun[@bs] a -> p a)
+    
+let partitionU d p = 
+  let cmp = d.cmp in 
+  let a, b = N.partitionCopyU d.data p in 
+  {data = a ; cmp}, { data = b; cmp}  
+
+let partition d p = partitionU d (fun[@bs] a -> p a)
+
+let subset a b = 
+  N.subset  ~cmp:a.cmp a.data b.data
+
+let intersect a b  : _ t = 
+  let cmp = a.cmp in 
+  match a.data, b.data with 
+  | None, _ -> { cmp; data = None}
+  | _, None -> { cmp; data = None}
+  | Some dataa0, Some datab0 ->  
+    let sizea, sizeb = 
+      N.lengthNode dataa0, N.lengthNode datab0 in          
+    let totalSize = sizea + sizeb in 
+    let tmp = A.makeUninitializedUnsafe totalSize in 
+    ignore (N.fillArray dataa0 0 tmp) ; 
+    ignore (N.fillArray datab0 sizea tmp);
+    let p = Belt_Id.getCmpInternal cmp in 
+    if (p (A.getUnsafe tmp (sizea - 1))
+          (A.getUnsafe tmp sizea) [@bs] < 0)
+       || 
+       (p 
+          (A.getUnsafe tmp (totalSize - 1))
+          (A.getUnsafe tmp 0) [@bs] < 0 
+       )
+    then {cmp; data = None}
+    else 
+      let tmp2 = A.makeUninitializedUnsafe (Pervasives.min sizea sizeb) in 
+      let k = Sort.intersectU tmp 0 sizea tmp sizea sizeb tmp2 0 p in 
+      {data = (N.fromSortedArrayAux tmp2 0 k);
+       cmp}
+        
+let diff a b : _ t = 
+  let cmp = a.cmp in 
+  let dataa = a.data in 
+  match dataa, b.data with 
+  | None, _ -> {cmp; data = None}
+  | _, None -> 
+    {data = (N.copy dataa); cmp}
+  | Some dataa0, Some datab0
+    -> 
+    let sizea, sizeb = N.lengthNode dataa0, N.lengthNode datab0 in  
+    let totalSize = sizea + sizeb in 
+    let tmp = A.makeUninitializedUnsafe totalSize in 
+    ignore ( N.fillArray dataa0 0 tmp) ; 
+    ignore (N.fillArray datab0 sizea tmp);
+    let p = Belt_Id.getCmpInternal cmp in 
+    if (p (A.getUnsafe tmp (sizea - 1))
+          (A.getUnsafe tmp sizea) [@bs] < 0)
+       || 
+       (p 
+          (A.getUnsafe tmp (totalSize - 1))
+          (A.getUnsafe tmp 0) [@bs] < 0 
+       )
+    then {data = (N.copy dataa); cmp}
+    else 
+      let tmp2 = A.makeUninitializedUnsafe sizea in 
+      let k = Sort.diffU tmp 0 sizea tmp sizea sizeb tmp2 0 p in 
+      {data = (N.fromSortedArrayAux tmp2 0 k); cmp}
+
+let union a b = 
+  let cmp = a.cmp in 
+  let dataa, datab =  a.data, b.data  in 
+  match dataa, datab with 
+  | None, _ -> {data = (N.copy datab); cmp}
+  | _, None -> {data = (N.copy dataa); cmp}
+  | Some dataa0, Some datab0 
+    -> 
+    let sizea, sizeb = N.lengthNode dataa0, N.lengthNode datab0 in 
+    let totalSize = sizea + sizeb in 
+    let tmp = A.makeUninitializedUnsafe totalSize in 
+    ignore (N.fillArray dataa0 0 tmp );
+    ignore (N.fillArray datab0 sizea tmp);
+    let p = (Belt_Id.getCmpInternal cmp)  in 
+    if p
+        (A.getUnsafe tmp (sizea - 1))
+        (A.getUnsafe tmp sizea) [@bs] < 0 then 
+        { data = (N.fromSortedArrayAux tmp 0 totalSize); cmp}
+    else   
+      let tmp2 = A.makeUninitializedUnsafe totalSize in 
+      let k = Sort.unionU tmp 0 sizea tmp sizea sizeb tmp2 0 p in 
+      {data = (N.fromSortedArrayAux tmp2 0 k); cmp}
+      
+let has d x =
+  N.has ~cmp:d.cmp d.data x
+
+let copy d = {data = (N.copy d.data); cmp = d.cmp}
+
+