@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/belt_internalSetInt.ml

@@ -0,0 +1,129 @@
+# 5 "others/internal_set.cppo.ml"
+type value = int
+module S = Belt_SortArrayInt
+
+
+# 12 "others/internal_set.cppo.ml"
+module N = Belt_internalAVLset
+module A = Belt_Array 
+
+
+type t = value N.t
+
+let rec has (t : t) (x : value)  =
+  match t with 
+  | None -> false
+  | Some n  ->                
+    let v = n.value in 
+    x = v || has (if x < v then n.left else n.right) x
+
+
+let rec compareAux e1 e2  =
+    match e1,e2 with 
+    | h1::t1, h2::t2 ->
+        let (k1 : value) ,k2 = h1.N.value , h2.N.value  in 
+        if k1 = k2 then  
+          compareAux 
+            (N.stackAllLeft h1.right t1 ) 
+            (N.stackAllLeft h2.right t2)
+        else if k1  < k2 then -1    
+        else 1
+    | _, _ -> 0   
+
+
+let cmp s1 s2 =
+  let len1, len2 = N.size s1, N.size s2 in   
+  if len1 = len2 then 
+    compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 [])
+  else if len1 < len2 then -1 else 1 
+
+let eq (s1 : t) s2 = 
+  cmp s1 s2 = 0
+
+
+
+
+
+(* This algorithm applies to BST, it does not need to be balanced tree *)  
+let rec subset (s1 : t) (s2 : t) =
+  match s1, s2 with
+    None, _ ->
+    true
+  | _, None ->
+    false
+  | Some t1, Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) ->
+    let {N.left = l1; value = v1; right = r1 } = t1 in  
+    let {N.left = l2; value = v2; right = r2 } = t2 in 
+    if v1 = v2 then
+      subset l1 l2 && subset r1 r2
+    else if v1 < v2 then
+      subset (N.create l1 v1 None) l2 && subset r1 s2
+    else
+      subset (N.create None v1 r1 ) r2 && subset l1 s2
+
+
+let rec get (n :t) (x : value) = 
+  match n with 
+  | None -> None
+  | Some t  ->    
+    let v = t.value in     
+    if x = v then Some v
+    else get (if x < v then t.left else t.right) x
+
+
+
+let rec getUndefined (n :t) (x : value)   = 
+  match n with 
+  | None -> Js.undefined
+  | Some t  ->    
+    let v = t.value in     
+    if x = v then Js.Undefined.return v
+    else getUndefined  (if x < v then t.left else t.right) x
+
+let rec getExn  (n :t) (x : value) = 
+  match n with 
+  | None -> raise Not_found
+  | Some t  ->    
+    let v = t.value in     
+    if x = v then  v
+    else getExn (if x < v then t.left else t.right) x
+
+(****************************************************************************)
+let rec addMutate  t  (x : value)=   
+  match t with 
+  | None -> 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                   
+         nt.left <- addMutate l x       
+       else   
+         nt.right <- addMutate r x;
+      );
+      Some (N.balMutate nt)
+
+
+
+let fromArray (xs : value array) =   
+  let len = A.length xs in 
+  if len = 0 then None
+  else
+    let next =  ref (S.strictlySortedLength xs ) 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 
+      result .contents<- addMutate result.contents (A.getUnsafe xs i) 
+    done ;
+    result.contents 
+
+
+

package/lib/ocaml/belt_internalSetString.ml

@@ -0,0 +1,129 @@
+# 2 "others/internal_set.cppo.ml"
+type value = string
+module S = Belt_SortArrayString
+
+
+# 12 "others/internal_set.cppo.ml"
+module N = Belt_internalAVLset
+module A = Belt_Array 
+
+
+type t = value N.t
+
+let rec has (t : t) (x : value)  =
+  match t with 
+  | None -> false
+  | Some n  ->                
+    let v = n.value in 
+    x = v || has (if x < v then n.left else n.right) x
+
+
+let rec compareAux e1 e2  =
+    match e1,e2 with 
+    | h1::t1, h2::t2 ->
+        let (k1 : value) ,k2 = h1.N.value , h2.N.value  in 
+        if k1 = k2 then  
+          compareAux 
+            (N.stackAllLeft h1.right t1 ) 
+            (N.stackAllLeft h2.right t2)
+        else if k1  < k2 then -1    
+        else 1
+    | _, _ -> 0   
+
+
+let cmp s1 s2 =
+  let len1, len2 = N.size s1, N.size s2 in   
+  if len1 = len2 then 
+    compareAux (N.stackAllLeft s1 []) (N.stackAllLeft s2 [])
+  else if len1 < len2 then -1 else 1 
+
+let eq (s1 : t) s2 = 
+  cmp s1 s2 = 0
+
+
+
+
+
+(* This algorithm applies to BST, it does not need to be balanced tree *)  
+let rec subset (s1 : t) (s2 : t) =
+  match s1, s2 with
+    None, _ ->
+    true
+  | _, None ->
+    false
+  | Some t1, Some t2 (* Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) *) ->
+    let {N.left = l1; value = v1; right = r1 } = t1 in  
+    let {N.left = l2; value = v2; right = r2 } = t2 in 
+    if v1 = v2 then
+      subset l1 l2 && subset r1 r2
+    else if v1 < v2 then
+      subset (N.create l1 v1 None) l2 && subset r1 s2
+    else
+      subset (N.create None v1 r1 ) r2 && subset l1 s2
+
+
+let rec get (n :t) (x : value) = 
+  match n with 
+  | None -> None
+  | Some t  ->    
+    let v = t.value in     
+    if x = v then Some v
+    else get (if x < v then t.left else t.right) x
+
+
+
+let rec getUndefined (n :t) (x : value)   = 
+  match n with 
+  | None -> Js.undefined
+  | Some t  ->    
+    let v = t.value in     
+    if x = v then Js.Undefined.return v
+    else getUndefined  (if x < v then t.left else t.right) x
+
+let rec getExn  (n :t) (x : value) = 
+  match n with 
+  | None -> raise Not_found
+  | Some t  ->    
+    let v = t.value in     
+    if x = v then  v
+    else getExn (if x < v then t.left else t.right) x
+
+(****************************************************************************)
+let rec addMutate  t  (x : value)=   
+  match t with 
+  | None -> 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                   
+         nt.left <- addMutate l x       
+       else   
+         nt.right <- addMutate r x;
+      );
+      Some (N.balMutate nt)
+
+
+
+let fromArray (xs : value array) =   
+  let len = A.length xs in 
+  if len = 0 then None
+  else
+    let next =  ref (S.strictlySortedLength xs ) 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 
+      result .contents<- addMutate result.contents (A.getUnsafe xs i) 
+    done ;
+    result.contents 
+
+
+

package/lib/ocaml/belt_internals.mli

@@ -0,0 +1,79 @@
+(**
+   Since [others] depend on this file, its public mli files **should not
+   export types** introduced here, otherwise it would cause 
+   conflicts here.
+
+   If the type exported here is also exported in modules from others,
+   you will get a type not equivalent.
+
+
+   Types defined here but should not export:
+   - ref (make sure not exported in public others/*.mli)
+*)
+
+external (^) : string -> string -> string = "#string_append"
+external ( = ) : 'a -> 'a -> bool = "%equal"
+external ( <> ) : 'a -> 'a -> bool = "%notequal"
+external ( == ) : 'a -> 'a -> bool = "%eq"
+external ( != ) : 'a -> 'a -> bool = "%noteq"
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external ( + ) : int -> int -> int = "%addint"
+external ( - ) : int -> int -> int = "%subint"
+external ( ~- ) : int -> int = "%negint"
+external ( * ) : int -> int -> int = "%mulint"
+external ( / ) : int -> int -> int = "%divint"
+external ( lsl ) : int -> int -> int = "%lslint"
+external ( lor ) : int -> int -> int = "%orint"
+external ( land ) : int -> int -> int = "%andint"
+external ( mod ) : int -> int -> int = "%modint"
+external ( lsr ) : int -> int -> int = "%lsrint"
+external ( lxor ) : int -> int -> int = "%xorint"
+external ( asr ) : int -> int -> int = "%asrint"
+type 'a ref = { mutable contents : 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+
+
+
+external ( || ) : bool -> bool -> bool = "%sequor"
+external ( && ) : bool -> bool -> bool = "%sequand"
+external not : bool -> bool = "%boolnot"
+
+external raise : exn -> 'a = "%raise"
+external ignore : 'a -> unit = "%ignore"
+external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
+
+external ( ** ) : float -> float -> float =  "pow" [@@bs.val] [@@bs.scope "Math"]
+external ( ~-. ) : float -> float = "%negfloat"
+external ( +. ) : float -> float -> float = "%addfloat"
+external ( -. ) : float -> float -> float = "%subfloat"
+external ( *. ) : float -> float -> float = "%mulfloat"
+external ( /. ) : float -> float -> float = "%divfloat"
+
+module Obj : sig
+  type t 
+  external field : t -> int -> t = "%obj_field" 
+  external set_field : t -> int -> t -> unit = "%obj_set_field"
+  external tag : t -> int = "?obj_tag" 
+  (* The compiler ensures (|0) operation *)
+  external set_tag : t -> int -> unit = "TAG" [@@bs.set]  
+  external repr : 'a -> t = "%identity"
+  external obj : t -> 'a = "%identity"
+  external magic : 'a -> 'b = "%identity"  
+  external size : t -> int = "#obj_length"
+end 
+
+
+
+module Pervasives : sig 
+  external compare : 'a -> 'a -> int = "%compare"
+  external not : bool -> bool = "%boolnot"
+  external min : 'a -> 'a -> 'a = "%bs_min"
+  external max : 'a -> 'a -> 'a = "%bs_max"
+  external ( = ) : 'a -> 'a -> bool = "%equal"
+end
+
+

package/lib/ocaml/buffer.ml

@@ -0,0 +1,250 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*    Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt    *)
+(*                                                                        *)
+(*   Copyright 1999 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Extensible buffers *)
+
+type t =
+ {mutable buffer : bytes;
+  mutable position : int;
+  mutable length : int;
+  initial_buffer : bytes}
+
+let create n =
+ let n = if n < 1 then 1 else n in
+ let s = Bytes.create n in
+ {buffer = s; position = 0; length = n; initial_buffer = s}
+
+let contents b = Bytes.sub_string b.buffer 0 b.position
+let to_bytes b = Bytes.sub b.buffer 0 b.position
+
+let sub b ofs len =
+  if ofs < 0 || len < 0 || ofs > b.position - len
+  then invalid_arg "Buffer.sub"
+  else Bytes.sub_string b.buffer ofs len
+
+
+let blit src srcoff dst dstoff len =
+  if len < 0 || srcoff < 0 || srcoff > src.position - len
+             || dstoff < 0 || dstoff > (Bytes.length dst) - len
+  then invalid_arg "Buffer.blit"
+  else
+    Bytes.blit src.buffer srcoff dst dstoff len
+
+
+let nth b ofs =
+  if ofs < 0 || ofs >= b.position then
+   invalid_arg "Buffer.nth"
+  else Bytes.unsafe_get b.buffer ofs
+
+
+let length b = b.position
+
+let clear b = b.position <- 0
+
+let reset b =
+  b.position <- 0; b.buffer <- b.initial_buffer;
+  b.length <- Bytes.length b.buffer
+
+let resize b more =
+  let len = b.length in
+  let new_len = ref len in
+  while b.position + more > !new_len do new_len := 2 * !new_len done;
+  let new_buffer = Bytes.create !new_len in
+  (* PR#6148: let's keep using [blit] rather than [unsafe_blit] in
+     this tricky function that is slow anyway. *)
+  Bytes.blit b.buffer 0 new_buffer 0 b.position;
+  b.buffer <- new_buffer;
+  b.length <- !new_len
+
+let add_char b c =
+  let pos = b.position in
+  if pos >= b.length then resize b 1;
+  Bytes.unsafe_set b.buffer pos c;
+  b.position <- pos + 1
+
+ let add_utf_8_uchar b u = match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0x007F ->
+     add_char b (Char.unsafe_chr u)
+ | u when u <= 0x07FF ->
+     let pos = b.position in
+     if pos + 2 > b.length then resize b 2;
+     Bytes.unsafe_set b.buffer (pos    )
+       (Char.unsafe_chr (0xC0 lor (u lsr 6)));
+     Bytes.unsafe_set b.buffer (pos + 1)
+       (Char.unsafe_chr (0x80 lor (u land 0x3F)));
+     b.position <- pos + 2
+ | u when u <= 0xFFFF ->
+     let pos = b.position in
+     if pos + 3 > b.length then resize b 3;
+     Bytes.unsafe_set b.buffer (pos    )
+       (Char.unsafe_chr (0xE0 lor (u lsr 12)));
+     Bytes.unsafe_set b.buffer (pos + 1)
+       (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)));
+     Bytes.unsafe_set b.buffer (pos + 2)
+       (Char.unsafe_chr (0x80 lor (u land 0x3F)));
+     b.position <- pos + 3
+ | u when u <= 0x10FFFF ->
+     let pos = b.position in
+     if pos + 4 > b.length then resize b 4;
+     Bytes.unsafe_set b.buffer (pos    )
+       (Char.unsafe_chr (0xF0 lor (u lsr 18)));
+     Bytes.unsafe_set b.buffer (pos + 1)
+       (Char.unsafe_chr (0x80 lor ((u lsr 12) land 0x3F)));
+     Bytes.unsafe_set b.buffer (pos + 2)
+       (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F)));
+     Bytes.unsafe_set b.buffer (pos + 3)
+       (Char.unsafe_chr (0x80 lor (u land 0x3F)));
+     b.position <- pos + 4
+ | _ -> assert false
+
+ let add_utf_16be_uchar b u = match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0xFFFF ->
+     let pos = b.position in
+     if pos + 2 > b.length then resize b 2;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (u lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u land 0xFF));
+     b.position <- pos + 2
+ | u when u <= 0x10FFFF ->
+     let u' = u - 0x10000 in
+     let hi = 0xD800 lor (u' lsr 10) in
+     let lo = 0xDC00 lor (u' land 0x3FF) in
+     let pos = b.position in
+     if pos + 4 > b.length then resize b 4;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (hi lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo land 0xFF));
+     b.position <- pos + 4
+ | _ -> assert false
+
+ let add_utf_16le_uchar b u = match Uchar.to_int u with
+ | u when u < 0 -> assert false
+ | u when u <= 0xFFFF ->
+     let pos = b.position in
+     if pos + 2 > b.length then resize b 2;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (u land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u lsr 8));
+     b.position <- pos + 2
+ | u when u <= 0x10FFFF ->
+     let u' = u - 0x10000 in
+     let hi = 0xD800 lor (u' lsr 10) in
+     let lo = 0xDC00 lor (u' land 0x3FF) in
+     let pos = b.position in
+     if pos + 4 > b.length then resize b 4;
+     Bytes.unsafe_set b.buffer (pos    ) (Char.unsafe_chr (hi land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi lsr 8));
+     Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo land 0xFF));
+     Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo lsr 8));
+     b.position <- pos + 4
+ | _ -> assert false
+
+let add_substring b s offset len =
+  if offset < 0 || len < 0 || offset > String.length s - len
+  then invalid_arg "Buffer.add_substring/add_subbytes";
+  let new_position = b.position + len in
+  if new_position > b.length then resize b len;
+  Bytes.blit_string s offset b.buffer b.position len;
+  b.position <- new_position
+
+let add_subbytes b s offset len =
+  add_substring b (Bytes.unsafe_to_string s) offset len
+
+let add_string b s =
+  let len = String.length s in
+  let new_position = b.position + len in
+  if new_position > b.length then resize b len;
+  Bytes.blit_string s 0 b.buffer b.position len;
+  b.position <- new_position
+
+let add_bytes b s = add_string b (Bytes.unsafe_to_string s)
+
+let add_buffer b bs =
+  add_subbytes b bs.buffer 0 bs.position
+
+let closing = function
+  | '(' -> ')'
+  | '{' -> '}'
+  | _ -> assert false
+
+(* opening and closing: open and close characters, typically ( and )
+   k: balance of opening and closing chars
+   s: the string where we are searching
+   start: the index where we start the search. *)
+let advance_to_closing opening closing k s start =
+  let rec advance k i lim =
+    if i >= lim then raise Not_found else
+    if s.[i] = opening then advance (k + 1) (i + 1) lim else
+    if s.[i] = closing then
+      if k = 0 then i else advance (k - 1) (i + 1) lim
+    else advance k (i + 1) lim in
+  advance k start (String.length s)
+
+let advance_to_non_alpha s start =
+  let rec advance i lim =
+    if i >= lim then lim else
+    match s.[i] with
+    | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> advance (i + 1) lim
+    | _ -> i in
+  advance start (String.length s)
+
+(* We are just at the beginning of an ident in s, starting at start. *)
+let find_ident s start lim =
+  if start >= lim then raise Not_found else
+  match s.[start] with
+  (* Parenthesized ident ? *)
+  | '(' | '{' as c ->
+     let new_start = start + 1 in
+     let stop = advance_to_closing c (closing c) 0 s new_start in
+     String.sub s new_start (stop - start - 1), stop + 1
+  (* Regular ident *)
+  | _ ->
+     let stop = advance_to_non_alpha s (start + 1) in
+     String.sub s start (stop - start), stop
+
+(* Substitute $ident, $(ident), or ${ident} in s,
+    according to the function mapping f. *)
+let add_substitute b f s =
+  let lim = String.length s in
+  let rec subst previous i =
+    if i < lim then begin
+      match s.[i] with
+      | '$' as current when previous = '\\' ->
+         add_char b current;
+         subst ' ' (i + 1)
+      | '$' ->
+         let j = i + 1 in
+         let ident, next_i = find_ident s j lim in
+         add_string b (f ident);
+         subst ' ' next_i
+      | current when previous == '\\' ->
+         add_char b '\\';
+         add_char b current;
+         subst ' ' (i + 1)
+      | '\\' as current ->
+         subst current (i + 1)
+      | current ->
+         add_char b current;
+         subst current (i + 1)
+    end else
+    if previous = '\\' then add_char b previous in
+  subst ' ' 0
+
+let truncate b len =
+    if len < 0 || len > length b then
+      invalid_arg "Buffer.truncate"
+    else
+      b.position <- len