@tellahq/rescript 10.1.0-alpha.1

package/lib/ocaml/callback.ml

@@ -0,0 +1,20 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+[@@@bs.config { flags = [|"-bs-no-cross-module-opt" |]}]
+(* Registering OCaml values with the C runtime for later callbacks *)
+
+
+let register _ _ = ()
+let register_exception _ _  = ()

package/lib/ocaml/callback.mli

@@ -0,0 +1,34 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Registering OCaml values with the C runtime.
+
+   This module allows OCaml values to be registered with the C runtime
+   under a symbolic name, so that C code can later call back registered
+   OCaml functions, or raise registered OCaml exceptions.
+*)
+
+val register : string -> 'a -> unit
+(** [Callback.register n v] registers the value [v] under
+   the name [n]. C code can later retrieve a handle to [v]
+   by calling [caml_named_value(n)]. *)
+
+val register_exception : string -> exn -> unit
+(** [Callback.register_exception n exn] registers the
+   exception contained in the exception value [exn]
+   under the name [n]. C code can later retrieve a handle to
+   the exception by calling [caml_named_value(n)]. The exception
+   value thus obtained is suitable for passing as first argument
+   to [raise_constant] or [raise_with_arg]. *)

package/lib/ocaml/camlinternalLazy.ml

@@ -0,0 +1,89 @@
+(* 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. *)
+
+ [@@@bs.config { flags = [|"-bs-no-cross-module-opt" |]}]
+ 
+(* Internals of forcing lazy values. *)
+type 'a t = {
+  mutable tag : bool [@bs.as "LAZY_DONE"] ; 
+  (* Invariant: name  *)
+  mutable value : 'a [@bs.as "VAL"]
+  (* its type is ['a] or [unit -> 'a ] *)
+}
+
+
+external%private fnToVal : (unit -> 'a [@bs]) -> 'a = "%identity"
+external%private valToFn :  'a -> (unit -> 'a [@bs])  = "%identity"
+external%private castToConcrete : 'a lazy_t -> 'a t   = "%identity"
+
+let is_val (type a ) (l : a lazy_t) : bool = 
+  (castToConcrete l ).tag  
+
+
+
+exception Undefined
+
+let%private forward_with_closure (type a ) (blk : a t) (closure : unit -> a [@bs]) : a = 
+  let result = closure () [@bs] in
+  (* do set_field BEFORE set_tag *)
+  blk.value <- result;
+  blk.tag<- true;
+  result
+
+
+let%private raise_undefined =  (fun [@bs] () -> raise Undefined)
+
+(* Assume [blk] is a block with tag lazy *)
+let%private force_lazy_block (type a ) (blk : a t) : a  =
+  let closure = valToFn blk.value in
+  blk.value <- fnToVal raise_undefined;
+  try
+    forward_with_closure blk closure
+  with e ->
+    blk.value <- fnToVal (fun [@bs] () -> raise e);
+    raise e
+
+
+(* Assume [blk] is a block with tag lazy *)
+let%private force_val_lazy_block (type a ) (blk : a t) : a  =
+  let closure  = valToFn blk.value  in
+  blk.value <-  fnToVal raise_undefined;
+  forward_with_closure blk closure
+
+
+
+let force (type a ) (lzv : a lazy_t) : a =
+    let lzv = (castToConcrete lzv : _ t) in 
+    if lzv.tag  then lzv.value else
+      force_lazy_block lzv
+
+
+
+
+let force_val (type a) (lzv : a lazy_t) : a =
+  let lzv : _ t = castToConcrete lzv in 
+  if lzv.tag then lzv.value  else
+    force_val_lazy_block lzv
+
+

package/lib/ocaml/camlinternalLazy.mli

@@ -0,0 +1,27 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Damien Doligez, projet Para, INRIA Rocquencourt            *)
+(*                                                                        *)
+(*   Copyright 1997 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Run-time support for lazy values.
+    All functions in this module are for system use only, not for the
+    casual user. *)
+
+exception Undefined
+
+val force : 'a lazy_t -> 'a
+(* instrumented by {!Matching} *)
+
+val force_val : 'a lazy_t -> 'a
+
+val is_val : 'a lazy_t -> bool     

package/lib/ocaml/camlinternalMod.ml

@@ -0,0 +1,21 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Xavier Leroy, projet Cristal, INRIA Rocquencourt              *)
+(*                                                                        *)
+(*   Copyright 2004 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+type shape =
+  | Function
+  | Lazy
+  | Class
+  | Module of shape array
+  | Value of Obj.t

package/lib/ocaml/camlinternalMod.mli

@@ -0,0 +1,25 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*          Xavier Leroy, projet Cristal, INRIA Rocquencourt              *)
+(*                                                                        *)
+(*   Copyright 2004 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Run-time support for recursive modules.
+    All functions in this module are for system use only, not for the
+    casual user. *)
+
+type shape =
+  | Function
+  | Lazy
+  | Class
+  | Module of shape array
+  | Value of Obj.t

package/lib/ocaml/char.ml

@@ -0,0 +1,76 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Character operations *)
+
+external code: char -> int = "%identity"
+external unsafe_chr: int -> char = "%identity"
+
+let chr n =
+  if n < 0 || n > 255 then invalid_arg "Char.chr" else unsafe_chr n
+
+external bytes_create: int -> bytes = "?create_bytes"
+external bytes_unsafe_set : bytes -> int -> char -> unit
+                           = "%bytes_unsafe_set"
+external unsafe_to_string : bytes -> string = "%bytes_to_string"
+
+let escaped = function
+  | '\'' -> "\\'"
+  | '\\' -> "\\\\"
+  | '\n' -> "\\n"
+  | '\t' -> "\\t"
+  | '\r' -> "\\r"
+  | '\b' -> "\\b"
+  | ' ' .. '~' as c ->
+      let s = bytes_create 1 in
+      bytes_unsafe_set s 0 c;
+      unsafe_to_string s
+  | c ->
+      let n = code c in
+      let s = bytes_create 4 in
+      bytes_unsafe_set s 0 '\\';
+      bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100));
+      bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10));
+      bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10));
+      unsafe_to_string s
+
+let lowercase c =
+  if (c >= 'A' && c <= 'Z')
+  || (c >= '\192' && c <= '\214')
+  || (c >= '\216' && c <= '\222')
+  then unsafe_chr(code c + 32)
+  else c
+
+let uppercase c =
+  if (c >= 'a' && c <= 'z')
+  || (c >= '\224' && c <= '\246')
+  || (c >= '\248' && c <= '\254')
+  then unsafe_chr(code c - 32)
+  else c
+
+let lowercase_ascii c =
+  if (c >= 'A' && c <= 'Z')
+  then unsafe_chr(code c + 32)
+  else c
+
+let uppercase_ascii c =
+  if (c >= 'a' && c <= 'z')
+  then unsafe_chr(code c - 32)
+  else c
+
+type t = char
+
+let compare c1 c2 = code c1 - code c2
+let equal (c1: t) (c2: t) = compare c1 c2 = 0

package/lib/ocaml/char.mli

@@ -0,0 +1,72 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Character operations. *)
+
+external code : char -> int = "%identity"
+(** Return the ASCII code of the argument. *)
+
+val chr : int -> char
+(** Return the character with the given ASCII code.
+   Raise [Invalid_argument "Char.chr"] if the argument is
+   outside the range 0--255. *)
+
+val escaped : char -> string
+(** Return a string representing the given character,
+    with special characters escaped following the lexical conventions
+    of OCaml.
+    All characters outside the ASCII printable range (32..126) are
+    escaped, as well as backslash, double-quote, and single-quote. *)
+
+val lowercase : char -> char
+  [@@ocaml.deprecated "Use Char.lowercase_ascii instead."]
+(** Convert the given character to its equivalent lowercase character,
+   using the ISO Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val uppercase : char -> char
+  [@@ocaml.deprecated "Use Char.uppercase_ascii instead."]
+(** Convert the given character to its equivalent uppercase character,
+   using the ISO Latin-1 (8859-1) character set.
+   @deprecated Functions operating on Latin-1 character set are deprecated. *)
+
+val lowercase_ascii : char -> char
+(** Convert the given character to its equivalent lowercase character,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+val uppercase_ascii : char -> char
+(** Convert the given character to its equivalent uppercase character,
+   using the US-ASCII character set.
+   @since 4.03.0 *)
+
+type t = char
+(** An alias for the type of characters. *)
+
+val compare: t -> t -> int
+(** The comparison function for characters, with the same specification as
+    {!Pervasives.compare}.  Along with the type [t], this function [compare]
+    allows the module [Char] to be passed as argument to the functors
+    {!Set.Make} and {!Map.Make}. *)
+
+val equal: t -> t -> bool
+(** The equal function for chars.
+    @since 4.03.0 *)
+
+(**/**)
+
+(* The following is for system use only. Do not call directly. *)
+
+external unsafe_chr : int -> char = "%identity"

package/lib/ocaml/complex.ml

@@ -0,0 +1,87 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Complex numbers *)
+
+type t = { re: float; im: float }
+
+let zero = { re = 0.0; im = 0.0 }
+let one = { re = 1.0; im = 0.0 }
+let i = { re = 0.0; im = 1.0 }
+
+let add x y = { re = x.re +. y.re; im = x.im +. y.im }
+
+let sub x y = { re = x.re -. y.re; im = x.im -. y.im }
+
+let neg x = { re = -. x.re; im = -. x.im }
+
+let conj x = { re = x.re; im = -. x.im }
+
+let mul x y = { re = x.re *. y.re -. x.im *. y.im;
+                im = x.re *. y.im +. x.im *. y.re }
+
+let div x y =
+  if abs_float y.re >= abs_float y.im then
+    let r = y.im /. y.re in
+    let d = y.re +. r *. y.im in
+    { re = (x.re +. r *. x.im) /. d;
+      im = (x.im -. r *. x.re) /. d }
+  else
+    let r = y.re /. y.im in
+    let d = y.im +. r *. y.re in
+    { re = (r *. x.re +. x.im) /. d;
+      im = (r *. x.im -. x.re) /. d }
+
+let inv x = div one x
+
+let norm2 x = x.re *. x.re +. x.im *. x.im
+
+let norm x =
+  (* Watch out for overflow in computing re^2 + im^2 *)
+  let r = abs_float x.re and i = abs_float x.im in
+  if r = 0.0 then i
+  else if i = 0.0 then r
+  else if r >= i then
+    let q = i /. r in r *. sqrt(1.0 +. q *. q)
+  else
+    let q = r /. i in i *. sqrt(1.0 +. q *. q)
+
+let arg x = atan2 x.im x.re
+
+let polar n a = { re = cos a *. n; im = sin a *. n }
+
+let sqrt x =
+  if x.re = 0.0 && x.im = 0.0 then { re = 0.0; im = 0.0 }
+  else begin
+    let r = abs_float x.re and i = abs_float x.im in
+    let w =
+      if r >= i then begin
+        let q = i /. r in
+        sqrt(r) *. sqrt(0.5 *. (1.0 +. sqrt(1.0 +. q *. q)))
+      end else begin
+        let q = r /. i in
+        sqrt(i) *. sqrt(0.5 *. (q +. sqrt(1.0 +. q *. q)))
+      end in
+    if x.re >= 0.0
+    then { re = w;  im = 0.5 *. x.im /. w }
+    else { re = 0.5 *. i /. w;  im = if x.im >= 0.0 then w else -. w }
+  end
+
+let exp x =
+  let e = exp x.re in { re = e *. cos x.im; im = e *. sin x.im }
+
+let log x = { re = log (norm x); im = atan2 x.im x.re }
+
+let pow x y = exp (mul y (log x))

package/lib/ocaml/complex.mli

@@ -0,0 +1,86 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *)
+(*                                                                        *)
+(*   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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(** Complex numbers.
+
+    This module provides arithmetic operations on complex numbers.
+    Complex numbers are represented by their real and imaginary parts
+    (cartesian representation).  Each part is represented by a
+    double-precision floating-point number (type [float]).   *)
+
+type t = { re: float; im: float }
+(** The type of complex numbers.  [re] is the real part and [im] the
+    imaginary part. *)
+
+val zero: t
+(** The complex number [0]. *)
+
+val one: t
+(** The complex number [1]. *)
+
+val i: t
+(** The complex number [i]. *)
+
+val neg: t -> t
+(** Unary negation. *)
+
+val conj: t -> t
+(** Conjugate: given the complex [x + i.y], returns [x - i.y]. *)
+
+val add: t -> t -> t
+(** Addition *)
+
+val sub: t -> t -> t
+(** Subtraction *)
+
+val mul: t -> t -> t
+(** Multiplication *)
+
+val inv: t -> t
+(** Multiplicative inverse ([1/z]). *)
+
+val div: t -> t -> t
+(** Division *)
+
+val sqrt: t -> t
+(** Square root.  The result [x + i.y] is such that [x > 0] or
+    [x = 0] and [y >= 0].
+    This function has a discontinuity along the negative real axis. *)
+
+val norm2: t -> float
+(** Norm squared: given [x + i.y], returns [x^2 + y^2]. *)
+
+val norm: t -> float
+(** Norm: given [x + i.y], returns [sqrt(x^2 + y^2)]. *)
+
+val arg: t -> float
+(** Argument.  The argument of a complex number is the angle
+    in the complex plane between the positive real axis and a line
+    passing through zero and the number.  This angle ranges from
+    [-pi] to [pi].  This function has a discontinuity along the
+    negative real axis. *)
+
+val polar: float -> float -> t
+(** [polar norm arg] returns the complex having norm [norm]
+    and argument [arg]. *)
+
+val exp: t -> t
+(** Exponentiation.  [exp z] returns [e] to the [z] power. *)
+
+val log: t -> t
+(** Natural logarithm (in base [e]). *)
+
+val pow: t -> t -> t
+(** Power function.  [pow z1 z2] returns [z1] to the [z2] power. *)

package/lib/ocaml/digest.ml

@@ -0,0 +1,66 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Message digest (MD5) *)
+
+type t = string
+
+let compare = String.compare
+let equal = String.equal
+
+external unsafe_string: string -> int -> int -> t = "?md5_string"
+
+let string str =
+  unsafe_string str 0 (String.length str)
+
+let bytes b = string (Bytes.unsafe_to_string b)
+
+let substring str ofs len =
+  if ofs < 0 || len < 0 || ofs > String.length str - len
+  then invalid_arg "Digest.substring"
+  else unsafe_string str ofs len
+
+let subbytes b ofs len = substring (Bytes.unsafe_to_string b) ofs len
+
+
+
+let char_hex n =
+  Char.unsafe_chr (n + if n < 10 then Char.code '0' else (Char.code 'a' - 10))
+
+let to_hex d =
+  if String.length d <> 16 then invalid_arg "Digest.to_hex";
+  let result = Bytes.create 32 in
+  for i = 0 to 15 do
+    let x = Char.code d.[i] in
+    Bytes.unsafe_set result (i*2) (char_hex (x lsr 4));
+    Bytes.unsafe_set result (i*2+1) (char_hex (x land 0x0f));
+  done;
+  Bytes.unsafe_to_string result
+
+let from_hex s =
+  if String.length s <> 32 then invalid_arg "Digest.from_hex";
+  let digit c =
+    match c with
+    | '0'..'9' -> Char.code c - Char.code '0'
+    | 'A'..'F' -> Char.code c - Char.code 'A' + 10
+    | 'a'..'f' -> Char.code c - Char.code 'a' + 10
+    | _ -> raise (Invalid_argument "Digest.from_hex")
+  in
+  let byte i = digit s.[i] lsl 4 + digit s.[i+1] in
+  let result = Bytes.create 16 in
+  for i = 0 to 15 do
+    Bytes.set result i (Char.chr (byte (2 * i)));
+  done;
+  Bytes.unsafe_to_string result