@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/setm.cppo.ml

@@ -0,0 +1,346 @@
+(* 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. *)
+
+(** This module is [`Belt.MutableSet`]() specialized with key type to be a primitive type.
+    It is more efficient in general, the  API is the same with [`Belt_MutableSet`]() except its key type is fixed,
+    and identity is not needed(using the built-in one)
+*)
+
+#ifdef TYPE_INT
+module I = Belt_internalSetInt
+module S = Belt_SortArrayInt
+#elif defined TYPE_STRING
+module I = Belt_internalSetString
+module S = Belt_SortArrayString
+#else
+  [%error "unknown type"]
+#endif
+module N = Belt_internalAVLset
+module A = Belt_Array
+
+type value = I.value
+(** The type of the set elements. *)
+
+
+type t = {
+  mutable data : I.t
+}
+(** The type of sets. *)
+
+
+let rec remove0 nt (x : value)=
+  let k = nt.N.value in
+  if x = k 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 x < k then
+        match nt.left with
+        | None -> Some nt
+        | Some l ->
+          nt.left <- (remove0 l x );
+          Some (N.balMutate nt)
+      else
+        match nt.right with
+        | None -> Some nt
+        | Some r ->
+          nt.right <- (remove0 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 oldRoot2 v in
+  if newRoot != oldRoot then
+    d.data <- newRoot
+
+let rec removeMany0 t xs i len  =
+  if i < len then
+    let ele = A.getUnsafe xs i in
+    let u = remove0 t ele in
+    match u with
+    | None -> None
+    | Some t -> removeMany0 t xs (i+1) len
+  else Some t
+
+
+let removeMany  (d : t) 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
+
+let rec removeCheck0  nt (x : value) removed =
+  let k = nt.N.value in
+  if x = k 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 x < k then
+        match nt.left with
+        | None -> Some nt
+        | Some l ->
+          nt.left <- (removeCheck0  l x removed);
+          Some (N.balMutate nt)
+      else
+        match nt.right with
+        | None -> Some nt
+        | Some r ->
+          nt.right <- (removeCheck0  r x removed);
+          Some (N.balMutate nt)
+    end
+
+
+
+let removeCheck  (d :  t) v =
+  let oldRoot = d.data in
+  match oldRoot with
+  | None -> false
+  | Some oldRoot2 ->
+    let removed = ref false in
+    let newRoot = removeCheck0  oldRoot2 v removed in
+    if newRoot != oldRoot then
+      d.data <- newRoot ;
+    removed.contents
+
+
+let rec addCheck0  t (x : value) added  =
+  match t with
+  | None ->
+    added .contents<- true;
+    N.singleton x
+  | Some nt ->
+    let k = nt.N.value in
+    if x = k then t
+    else
+      let {N.left = l; right =  r} = nt in
+      (if x < k then
+         let ll = addCheck0  l x added in
+         nt.left <- ll
+       else
+         nt.right <- (addCheck0 r x added );
+      );
+      Some (N.balMutate nt)
+
+let addCheck (m :  t) e =
+  let oldRoot = m.data in
+  let added = ref false in
+  let newRoot = addCheck0 oldRoot e added in
+  if newRoot != oldRoot then
+    m.data <- newRoot;
+  added.contents
+
+let add d k =
+  let oldRoot = d.data in
+  let v = I.addMutate oldRoot k in
+  if v != oldRoot then
+     d.data <- v
+
+
+let addArrayMutate t  xs =
+  let v = ref t in
+  for i = 0 to A.length xs - 1 do
+    v.contents<- I.addMutate v.contents (A.getUnsafe xs i)
+  done ;
+  v.contents
+
+let mergeMany d arr =
+  d.data <- addArrayMutate (d.data) arr
+
+
+
+let make  () = {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 xs =
+  {data = N.fromSortedArrayUnsafe xs}
+
+let checkInvariantInternal d =
+  N.checkInvariantInternal (d.data)
+
+
+
+let fromArray xs =
+  { data = I.fromArray xs}
+
+let cmp d0 d1 =
+  I.cmp (d0.data) (d1.data)
+let eq d0 d1 =
+  I.eq (d0.data) (d1.data)
+let get d x =
+  I.get (d.data) x
+let getUndefined d x =
+  I.getUndefined (d.data) x
+let getExn d x =
+  I.getExn (d.data) x
+
+let split d  key =
+  let arr = N.toArray (d.data) in
+  let i = S.binarySearch arr key   in
+  let len = A.length arr in
+  if i < 0 then
+    let next = - i -1 in
+    (
+      {data = N.fromSortedArrayAux arr 0 next}
+    ,
+
+      {data = N.fromSortedArrayAux arr next (len - next)}
+    ), false
+  else
+    (
+      {data = N.fromSortedArrayAux arr 0 i}
+    ,
+
+      {data = (N.fromSortedArrayAux arr (i+1) (len - i - 1))}
+      ), true
+
+let keepU d p =
+  {data = (N.keepCopyU (d.data) p )}
+let keep d p = keepU d (fun[@bs] a -> p a)
+
+let partitionU d p =
+  let a , b = N.partitionCopyU (d.data) p in
+  {data = a}, {data = b}
+let partition d p = partitionU d (fun[@bs] a -> p a)
+
+let subset a b = I.subset  a.data b.data
+let intersect dataa datab  =
+  let dataa, datab = dataa.data, datab.data in
+    match dataa, datab with
+    | None, _ -> make ()
+    | _, None -> make ()
+    | 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);
+    if ((A.getUnsafe tmp (sizea - 1) <
+        A.getUnsafe tmp sizea))
+      ||
+      (
+      (A.getUnsafe tmp (totalSize - 1) <
+      A.getUnsafe tmp 0)
+      )
+       then make ()
+    else
+    let tmp2 = A.makeUninitializedUnsafe (Pervasives.min sizea sizeb) in
+    let k = S.intersect tmp 0 sizea tmp sizea sizeb tmp2 0  in
+    {data = (N.fromSortedArrayAux tmp2 0 k)}
+
+let diff dataa datab : t =
+  let dataa, datab = dataa.data, datab.data in
+  match dataa, datab with
+  | None, _ -> make ()
+  | _, None -> {data = N.copy dataa}
+  | 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);
+    if ( (A.getUnsafe tmp (sizea - 1)) <
+        (A.getUnsafe tmp sizea))
+      ||
+      (A.getUnsafe tmp (totalSize - 1)
+      < A.getUnsafe tmp 0)
+       then {data = N.copy dataa}
+    else
+    let tmp2 = A.makeUninitializedUnsafe sizea in
+    let k = S.diff tmp 0 sizea tmp sizea sizeb tmp2 0  in
+    {data = (N.fromSortedArrayAux tmp2 0 k)}
+
+let union (dataa : t)  (datab : t) : t =
+  let dataa, datab = dataa.data, datab.data in
+   match dataa, datab with
+  | None, _ -> {data = (N.copy datab)}
+  | _, None -> {data = (N.copy dataa)}
+  | 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);
+    if
+      (A.getUnsafe tmp (sizea - 1) <
+      A.getUnsafe tmp sizea)  then
+      {data = (N.fromSortedArrayAux tmp 0 totalSize) }
+    else
+      let tmp2 = A.makeUninitializedUnsafe totalSize in
+      let k = S.union tmp 0 sizea tmp sizea sizeb tmp2 0  in
+      {data = (N.fromSortedArrayAux tmp2 0 k) }
+
+let has d x = I.has (d.data) x
+
+let copy d = {data = (N.copy (d.data))}

package/lib/ocaml/setm.cppo.mli

@@ -0,0 +1,126 @@
+(* 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. *)
+
+(**
+  This module is [`Belt.MutableSet`]() specialized with key type to be a primitive type.
+
+  It is more efficient in general, the  API is the same with [`Belt.MutableSet`]() except its key type is fixed,
+  and identity is not needed(using the built-in one)
+
+  **See** [`Belt.MutableSet`]()
+*)
+
+
+#ifdef TYPE_STRING
+type value = string
+#elif defined TYPE_INT
+type value = int
+#else
+[%error "unknown type"]
+#endif
+  (** The type of the set elements. *)
+
+
+type t
+(** The type of sets. *)
+
+val make: unit -> t
+
+val fromArray: value array -> t
+val fromSortedArrayUnsafe: value array -> t
+
+val copy: t -> t
+val isEmpty: t -> bool
+val has: t -> value -> bool
+
+val add: t -> value -> unit
+val addCheck: t -> value -> bool
+val mergeMany: t -> value array -> unit
+val remove: t -> value -> unit
+val removeCheck: t -> value -> bool
+val removeMany: t -> value array -> unit
+
+val union: t -> t -> t
+val intersect: t -> t -> t
+val diff: t -> t -> t
+val subset: t -> t -> bool
+
+val cmp: t -> t -> int
+val eq: t -> t -> bool
+
+
+val forEachU: t -> (value -> unit [@bs]) ->  unit
+val forEach: t -> (value -> unit ) ->  unit
+(** In increasing order*)
+
+val reduceU: t -> 'a -> ('a -> value -> 'a [@bs]) -> 'a
+val reduce: t -> 'a -> ('a -> value -> 'a ) -> 'a
+(** Iterate in increasing order. *)
+
+val everyU: t -> (value -> bool [@bs]) -> bool
+val every: t -> (value -> bool) ->  bool
+(** `every p s` checks if all elements of the set
+  satisfy the predicate `p`. Order unspecified. *)
+
+val someU: t -> (value -> bool [@bs]) -> bool
+val some: t -> (value -> bool) ->  bool
+(** `some p s` checks if at least one element of
+  the set satisfies the predicate `p`. Oder unspecified. *)
+
+val keepU: t -> (value -> bool [@bs]) ->  t
+val keep: t -> (value -> bool) ->  t
+(** `keep s p` returns a fresh copy of the set of all elements in `s`
+  that satisfy predicate `p`. *)
+
+val partitionU: t -> (value -> bool [@bs]) ->  t * t
+val partition: t -> (value -> bool) ->  t * t
+(** `partition s p` returns a fresh copy pair of sets `(s1, s2)`, where
+  `s1` is the set of all the elements of `s` that satisfy the
+  predicate `p`, and `s2` is the set of all the elements of
+  `s` that do not satisfy `p`. *)
+
+val size: t -> int
+val toList: t -> value list
+(** In increasing order with respect *)
+
+val toArray: t -> value array
+(** In increasing order with respect *)
+
+val minimum: t -> value option
+val minUndefined: t -> value Js.undefined
+val maximum: t -> value option
+val maxUndefined: t -> value Js.undefined
+
+val get:  t -> value -> value option
+val getUndefined:  t -> value -> value Js.undefined
+val getExn: t -> value -> value
+val split:  t -> value  -> (t * t) * bool
+(**
+  `split s key` return a fresh copy of each
+*)
+
+val checkInvariantInternal: t -> unit
+(**
+  **raise** when invariant is not held
+*)