diff --git a/jscomp/runtime/bs_stdlib_mini.mli b/jscomp/runtime/bs_stdlib_mini.mli deleted file mode 100644 index 402d46011c..0000000000 --- a/jscomp/runtime/bs_stdlib_mini.mli +++ /dev/null @@ -1,77 +0,0 @@ -(** - 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" - 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 - - diff --git a/jscomp/runtime/bs_stdlib_mini.resi b/jscomp/runtime/bs_stdlib_mini.resi new file mode 100644 index 0000000000..c7f6c29da2 --- /dev/null +++ b/jscomp/runtime/bs_stdlib_mini.resi @@ -0,0 +1,70 @@ +/** + 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 *.mli in others folder) +*/ +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 ref<'a> = {mutable contents: 'a} +external ref: 'a => ref<'a> = "%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" + +@val @scope("Math") external \"**": (float, float) => float = "pow" +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: { + 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" + external repr: 'a => t = "%identity" + external obj: t => 'a = "%identity" + external magic: 'a => 'b = "%identity" + external size: t => int = "#obj_length" +} + +module Pervasives: { + 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" +} diff --git a/jscomp/runtime/caml.ml b/jscomp/runtime/caml.ml deleted file mode 100644 index 8575733dbb..0000000000 --- a/jscomp/runtime/caml.ml +++ /dev/null @@ -1,94 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - -let int_compare (x : int) (y: int) : int = - if x < y then -1 else if x = y then 0 else 1 -let bool_compare (x : bool) (y : bool): int = - match x,y with - | true, true | false , false -> 0 - | true, false -> 1 - | false, true -> -1 - - - -let float_compare (x : float) (y : float ) = - if x = y then 0 - else if x < y then -1 - else if x > y then 1 - else if x = x then 1 - else if y = y then -1 - else 0 - -(* Lexical order *) -let string_compare (s1 : string) (s2 : string) : int = - if s1 = s2 then 0 - else if s1 < s2 then -1 - else 1 - - -type 'a selector = 'a -> 'a -> 'a - -(* could be replaced by [Math.min], but it seems those built-ins are slower *) -let bool_min (x : bool) y : bool = - if x then y else x -let int_min (x : int) (y : int) : int = - if x < y then x else y -let float_min (x : float) y = - if x < y then x else y -let string_min (x : string) y = - if x < y then x else y - -let bool_max (x : bool) y : bool = - if x then x else y -let int_max (x : int) (y : int) : int = - if x > y then x else y -let float_max (x : float) y = - if x > y then x else y -let string_max (x : string) y = - if x > y then x else y -type i64 = Caml_int64_extern.t -let i64_eq ( x : i64) (y : i64) = - x.lo = y.lo && x.hi = y.hi - -let i64_ge ( {hi; lo } : i64) ( {hi = other_hi; lo = other_lo}: i64) : bool = - if hi > other_hi then true - else if hi < other_hi then false - else lo >= other_lo - -let i64_neq x y = Pervasives.not (i64_eq x y) -let i64_lt x y = Pervasives.not (i64_ge x y) -let i64_gt ( x : i64) ( y : i64) = - if x.hi > y.hi then - true - else if x.hi < y.hi then - false - else - x.lo > y.lo - - -let i64_le x y = Pervasives.not (i64_gt x y) - -let i64_min x y = if i64_lt x y then x else y -let i64_max x y = if i64_gt x y then x else y diff --git a/jscomp/runtime/caml.res b/jscomp/runtime/caml.res new file mode 100644 index 0000000000..b4cee4ec20 --- /dev/null +++ b/jscomp/runtime/caml.res @@ -0,0 +1,153 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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. */ + +let int_compare = (x: int, y: int): int => + if x < y { + -1 + } else if x == y { + 0 + } else { + 1 + } +let bool_compare = (x: bool, y: bool): int => + switch (x, y) { + | (true, true) | (false, false) => 0 + | (true, false) => 1 + | (false, true) => -1 + } + +let float_compare = (x: float, y: float) => + if x == y { + 0 + } else if x < y { + -1 + } else if x > y { + 1 + } else if x == x { + 1 + } else if y == y { + -1 + } else { + 0 + } + +/* Lexical order */ +let string_compare = (s1: string, s2: string): int => + if s1 == s2 { + 0 + } else if s1 < s2 { + -1 + } else { + 1 + } + +type selector<'a> = ('a, 'a) => 'a + +/* could be replaced by [Math.min], but it seems those built-ins are slower */ +let bool_min = (x: bool, y): bool => + if x { + y + } else { + x + } +let int_min = (x: int, y: int): int => + if x < y { + x + } else { + y + } +let float_min = (x: float, y) => + if x < y { + x + } else { + y + } +let string_min = (x: string, y) => + if x < y { + x + } else { + y + } + +let bool_max = (x: bool, y): bool => + if x { + x + } else { + y + } +let int_max = (x: int, y: int): int => + if x > y { + x + } else { + y + } +let float_max = (x: float, y) => + if x > y { + x + } else { + y + } +let string_max = (x: string, y) => + if x > y { + x + } else { + y + } +type i64 = Caml_int64_extern.t +let i64_eq = (x: i64, y: i64) => x.lo == y.lo && x.hi == y.hi + +let i64_ge = ({hi, lo}: i64, {hi: other_hi, lo: other_lo}: i64): bool => + if hi > other_hi { + true + } else if hi < other_hi { + false + } else { + lo >= other_lo + } + +let i64_neq = (x, y) => Pervasives.not(i64_eq(x, y)) +let i64_lt = (x, y) => Pervasives.not(i64_ge(x, y)) +let i64_gt = (x: i64, y: i64) => + if x.hi > y.hi { + true + } else if x.hi < y.hi { + false + } else { + x.lo > y.lo + } + +let i64_le = (x, y) => Pervasives.not(i64_gt(x, y)) + +let i64_min = (x, y) => + if i64_lt(x, y) { + x + } else { + y + } +let i64_max = (x, y) => + if i64_gt(x, y) { + x + } else { + y + } diff --git a/jscomp/runtime/caml_float.mli b/jscomp/runtime/caml.resi similarity index 54% rename from jscomp/runtime/caml_float.mli rename to jscomp/runtime/caml.resi index cbc0e84e6d..f300ae7dac 100644 --- a/jscomp/runtime/caml_float.mli +++ b/jscomp/runtime/caml.resi @@ -1,4 +1,4 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. * * 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 @@ -20,25 +20,31 @@ * * 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. *) - - - - - -(** *) -external floor : float -> float = "Math.floor" [@@bs.val] -external int_of_float : float -> int = "%intoffloat" -external float_of_int : int -> float = "%floatofint" -val int_float_of_bits : int -> float -val int_bits_of_float : float -> int - -val modf_float : float -> float * float - -val ldexp_float : float -> int -> float -val frexp_float : float -> float * int - -val copysign_float : float -> float -> float -val expm1_float : float -> float - -val hypot_float : float -> float -> float + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +type selector<'a> = ('a, 'a) => 'a + +let int_compare: (int, int) => int +let bool_compare: (bool, bool) => int +let float_compare: (float, float) => int +let string_compare: (string, string) => int + +let bool_min: selector +let int_min: selector +let float_min: selector +let string_min: selector + +let bool_max: selector +let int_max: selector +let float_max: selector +let string_max: selector + +let i64_eq: (Caml_int64_extern.t, Caml_int64_extern.t) => bool +let i64_neq: (Caml_int64_extern.t, Caml_int64_extern.t) => bool +let i64_lt: (Caml_int64_extern.t, Caml_int64_extern.t) => bool +let i64_gt: (Caml_int64_extern.t, Caml_int64_extern.t) => bool +let i64_le: (Caml_int64_extern.t, Caml_int64_extern.t) => bool +let i64_ge: (Caml_int64_extern.t, Caml_int64_extern.t) => bool + +let i64_min: (Caml_int64_extern.t, Caml_int64_extern.t) => Caml_int64_extern.t +let i64_max: (Caml_int64_extern.t, Caml_int64_extern.t) => Caml_int64_extern.t diff --git a/jscomp/runtime/caml_array.ml b/jscomp/runtime/caml_array.ml deleted file mode 100644 index 07a57a186e..0000000000 --- a/jscomp/runtime/caml_array.ml +++ /dev/null @@ -1,103 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - -external dup : 'a array -> (_ [@bs.as 0]) -> 'a array = - "slice" [@@bs.send] - -let %private {unsafe_get = (.!()) ; unsafe_set = (.!()<-)} = - (module Caml_array_extern) - - -let sub (x : 'a array) (offset : int) (len : int) = - let result = Caml_array_extern.new_uninitialized len in - let j = {contents = 0} and i = {contents = offset} in - while j.contents < len do - result.!(j.contents) <- x.!(i.contents); - j.contents <- j.contents + 1; - i.contents <- i.contents + 1; - done; - result - - -let rec len acc l = - match l with - | [] -> acc - | x::xs -> len (Caml_array_extern.length x + acc) xs - -let rec fill arr i l = - match l with - | [] -> () - | x :: xs -> - let l = Caml_array_extern.length x in - let k = {contents = i} in - let j = {contents = 0} in - while j.contents < l do - arr.!(k.contents) <- x .!(j.contents); - k.contents <- k.contents + 1; - j.contents <- j.contents + 1; - done; - fill arr k.contents xs - -let concat (l : 'a array list) : 'a array = - let v = len 0 l in - let result = Caml_array_extern.new_uninitialized v in - fill result 0 l ; - result - -let set xs index newval = - if index <0 || index >= Caml_array_extern.length xs - then raise (Invalid_argument "index out of bounds") - else xs.!( index)<- newval - -let get xs index = - if index <0 || index >= Caml_array_extern.length xs then - raise (Invalid_argument "index out of bounds") - else xs.!( index) - - -let make len init = - let b = Caml_array_extern.new_uninitialized len in - for i = 0 to len - 1 do - b.!(i) <- init - done; - b - -let make_float len = - let b = Caml_array_extern.new_uninitialized len in - for i = 0 to len - 1 do - b.!(i) <- 0. - done; - b - -let blit a1 i1 a2 i2 len = - if i2 <= i1 then - for j = 0 to len - 1 do - a2.! (j+i2) <- a1.! (j+i1) - done - else - for j = len - 1 downto 0 do - a2 .!(j+i2) <- a1.! (j+i1) - done - diff --git a/jscomp/runtime/caml_array.res b/jscomp/runtime/caml_array.res new file mode 100644 index 0000000000..bcd996ae31 --- /dev/null +++ b/jscomp/runtime/caml_array.res @@ -0,0 +1,107 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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. */ + +@send external dup: (array<'a>, @as(0) _) => array<'a> = "slice" + +%%private(let {unsafe_get, unsafe_set} = module(Caml_array_extern)) + +let sub = (x: array<'a>, offset: int, len: int) => { + let result = Caml_array_extern.new_uninitialized(len) + let j = {contents: 0} and i = {contents: offset} + while j.contents < len { + result->unsafe_set(j.contents, x->unsafe_get(i.contents)) + j.contents = j.contents + 1 + i.contents = i.contents + 1 + } + result +} + +let rec len = (acc, l) => + switch l { + | list{} => acc + | list{x, ...xs} => len(Caml_array_extern.length(x) + acc, xs) + } + +let rec fill = (arr, i, l) => + switch l { + | list{} => () + | list{x, ...xs} => + let l = Caml_array_extern.length(x) + let k = {contents: i} + let j = {contents: 0} + while j.contents < l { + arr->unsafe_set(k.contents, x->unsafe_get(j.contents)) + k.contents = k.contents + 1 + j.contents = j.contents + 1 + } + fill(arr, k.contents, xs) + } + +let concat = (l: list>): array<'a> => { + let v = len(0, l) + let result = Caml_array_extern.new_uninitialized(v) + fill(result, 0, l) + result +} + +let set = (xs, index, newval) => + if index < 0 || index >= Caml_array_extern.length(xs) { + raise(Invalid_argument("index out of bounds")) + } else { + xs->unsafe_set(index, newval) + } + +let get = (xs, index) => + if index < 0 || index >= Caml_array_extern.length(xs) { + raise(Invalid_argument("index out of bounds")) + } else { + xs->unsafe_get(index) + } + +let make = (len, init) => { + let b = Caml_array_extern.new_uninitialized(len) + for i in 0 to len - 1 { + b->unsafe_set(i, init) + } + b +} + +let make_float = len => { + let b = Caml_array_extern.new_uninitialized(len) + for i in 0 to len - 1 { + b->unsafe_set(i, 0.) + } + b +} + +let blit = (a1, i1, a2, i2, len) => + if i2 <= i1 { + for j in 0 to len - 1 { + a2->unsafe_set(j + i2, a1->unsafe_get(j + i1)) + } + } else { + for j in len - 1 downto 0 { + a2->unsafe_set(j + i2, a1->unsafe_get(j + i1)) + } + } diff --git a/jscomp/runtime/caml_sys.mli b/jscomp/runtime/caml_array.resi similarity index 76% rename from jscomp/runtime/caml_sys.mli rename to jscomp/runtime/caml_array.resi index 0768b3aa9e..af94891e64 100644 --- a/jscomp/runtime/caml_sys.mli +++ b/jscomp/runtime/caml_array.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,25 +17,23 @@ * 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. *) - - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -val sys_getenv : string -> string +let dup: array<'a> => array<'a> -val sys_time : unit -> float +let sub: (array<'a>, int, int) => array<'a> -val os_type : unit -> string +let concat: list> => array<'a> +let make: (int, 'a) => array<'a> -val sys_getcwd : unit -> string +let make_float: int => array -val sys_get_argv : unit -> string * string array +let blit: (array<'a>, int, array<'a>, int, int) => unit -val sys_exit : int -> unit +let get: (array<'a>, int) => 'a -val sys_is_directory : string -> bool -val sys_file_exists : string -> bool +let set: (array<'a>, int, 'a) => unit diff --git a/jscomp/runtime/caml_array_extern.ml b/jscomp/runtime/caml_array_extern.ml deleted file mode 100644 index ab60477f67..0000000000 --- a/jscomp/runtime/caml_array_extern.ml +++ /dev/null @@ -1,14 +0,0 @@ - - -external new_uninitialized : int -> 'a array = "Array" [@@bs.new] -external append : 'a array -> 'a array -> 'a array = "concat" [@@bs.send] -external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" -external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" -external length : 'a array -> int = "%array_length" - - -(* - Could be replaced by {!Caml_array.caml_make_vect} - Leave here temporarily since we have marked it side effect free internally -*) -external make : int -> 'a -> 'a array = "?make_vect" \ No newline at end of file diff --git a/jscomp/runtime/caml_array_extern.res b/jscomp/runtime/caml_array_extern.res new file mode 100644 index 0000000000..84b2ac3406 --- /dev/null +++ b/jscomp/runtime/caml_array_extern.res @@ -0,0 +1,11 @@ +@new external new_uninitialized: int => array<'a> = "Array" +@send external append: (array<'a>, array<'a>) => array<'a> = "concat" +external unsafe_get: (array<'a>, int) => 'a = "%array_unsafe_get" +external unsafe_set: (array<'a>, int, 'a) => unit = "%array_unsafe_set" +external length: array<'a> => int = "%array_length" + +/* + Could be replaced by {!Caml_array.caml_make_vect} + Leave here temporarily since we have marked it side effect free internally +*/ +external make: (int, 'a) => array<'a> = "?make_vect" diff --git a/jscomp/runtime/caml_bytes.ml b/jscomp/runtime/caml_bytes.ml deleted file mode 100644 index 81de368a29..0000000000 --- a/jscomp/runtime/caml_bytes.ml +++ /dev/null @@ -1,102 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - -external new_uninitialized : int -> bytes = "Array" [@@bs.new] - -external (.![]) : bytes -> int -> char = "%bytes_unsafe_get" -external (.![]<-) : bytes -> int -> char -> unit = "%bytes_unsafe_set" -external length : bytes -> int = "%bytes_length" - - -let set s i ch = - if i < 0 || i >= length s then - raise (Invalid_argument "index out of bounds") - else s.![i] <- ch - -let get s i = - if i < 0 || i >= length s then - raise (Invalid_argument "index out of bounds") - else s.![i] - - -let create len : bytes = - (* Node raise [RangeError] exception *) - if len < 0 then raise (Invalid_argument "String.create") - else - let result = new_uninitialized len in - for i = 0 to len - 1 do - result.![i] <- '\000' - done ; - result - - -let rec bytes_compare_aux (s1 : bytes) (s2 : bytes) off len def = - if off < len then - let a, b = s1.![off], s2.![off] in - if a > b then 1 - else if a < b then -1 - else bytes_compare_aux s1 s2 (off + 1) len def - else def - -(* code path could be using a tuple if we can eliminate the tuple allocation for code below - {[ - let (len, v) = - if len1 = len2 then (..,...) - else (.., .) - ]} - -*) -let bytes_compare (s1 : bytes) (s2 : bytes) : int = - let len1, len2 = length s1, length s2 in - if len1 = len2 then - bytes_compare_aux s1 s2 0 len1 0 - else if len1 < len2 then - bytes_compare_aux s1 s2 0 len1 (-1) - else - bytes_compare_aux s1 s2 0 len2 1 - -let rec bytes_equal_aux (s1 : bytes) s2 (off : int) len = - if off = len then true - else - let a, b = s1.![off], s2.![off] in - a = b - && bytes_equal_aux s1 s2 (off + 1) len - -let bytes_equal (s1 : bytes) (s2 : bytes) : bool = - let len1, len2 = length s1, length s2 in - len1 = len2 && - bytes_equal_aux s1 s2 0 len1 - -let bytes_greaterthan (s1 : bytes) s2 = - bytes_compare s1 s2 > 0 - -let bytes_greaterequal (s1 : bytes) s2 = - bytes_compare s1 s2 >= 0 - -let bytes_lessthan (s1 : bytes) s2 = - bytes_compare s1 s2 < 0 - -let bytes_lessequal (s1 : bytes) s2 = - bytes_compare s1 s2 <= 0 \ No newline at end of file diff --git a/jscomp/runtime/caml_bytes.res b/jscomp/runtime/caml_bytes.res new file mode 100644 index 0000000000..afab0966dd Binary files /dev/null and b/jscomp/runtime/caml_bytes.res differ diff --git a/jscomp/runtime/caml_array.mli b/jscomp/runtime/caml_bytes.resi similarity index 74% rename from jscomp/runtime/caml_array.mli rename to jscomp/runtime/caml_bytes.resi index 2a36b30c72..a76db5d5f8 100644 --- a/jscomp/runtime/caml_array.mli +++ b/jscomp/runtime/caml_bytes.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,23 +17,24 @@ * 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. *) + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -val dup : 'a array -> 'a array +let create: int => bytes -val sub : 'a array -> int -> int -> 'a array +let get: (bytes, int) => char +let set: (bytes, int, char) => unit -val concat : 'a array list -> 'a array +let bytes_compare: (bytes, bytes) => int -val make : int -> 'a -> 'a array +let bytes_greaterthan: (bytes, bytes) => bool -val make_float : int -> float array +let bytes_greaterequal: (bytes, bytes) => bool -val blit : 'a array -> int -> 'a array -> int -> int -> unit +let bytes_lessthan: (bytes, bytes) => bool -val get: 'a array -> int -> 'a +let bytes_lessequal: (bytes, bytes) => bool -val set: 'a array -> int -> 'a -> unit +let bytes_equal: (bytes, bytes) => bool diff --git a/jscomp/runtime/caml_exceptions.ml b/jscomp/runtime/caml_exceptions.res similarity index 83% rename from jscomp/runtime/caml_exceptions.ml rename to jscomp/runtime/caml_exceptions.res index 9e8cc18553..d4e53adb36 100644 --- a/jscomp/runtime/caml_exceptions.ml +++ b/jscomp/runtime/caml_exceptions.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,36 +17,28 @@ * 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. *) - -type t = { - id : string [@bs.as "RE_EXN_ID"]; - -} + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +type t = {@as("RE_EXN_ID") id: string} -(** +/** Could be exported for better inlining It's common that we have {[ a = caml_set_oo_id([248,"string",0]) ]} This can be inlined as {[ a = caml_set_oo_id([248,"string", caml_oo_last_id++]) ]} -*) - -let id = ref 0 - - -let create (str : string) : string = - id .contents <- id.contents + 1; - str ^ "/" ^(Obj.magic (id.contents : int) : string) +*/ +let id = ref(0) +let create = (str: string): string => { + id.contents = id.contents + 1 + str ++ ("/" ++ (Obj.magic((id.contents: int)): string)) +} - - -(** +/** This function should never throw It could be either customized exception or built in exception Note due to that in OCaml extensible variants have the same @@ -76,13 +68,13 @@ let create (str : string) : string = ]} This is not a problem in `try .. with` since the logic above is not expressible, see more design in [destruct_exn.md] -*) -let is_extension (type a ) (e : a) : bool = - if Js.testAny e then false - else Js.typeof (Obj.magic e : t) .id = "string" - - - - -(**FIXME: remove the trailing `/` *) -let exn_slot_name (x : t) : string = x.id +*/ +let is_extension = (type a, e: a): bool => + if Js.testAny(e) { + false + } else { + Js.typeof((Obj.magic(e): t).id) == "string" + } + +/** FIXME: remove the trailing `/` */ +let exn_slot_name = (x: t): string => x.id diff --git a/jscomp/runtime/caml_external_polyfill.ml b/jscomp/runtime/caml_external_polyfill.res similarity index 81% rename from jscomp/runtime/caml_external_polyfill.ml rename to jscomp/runtime/caml_external_polyfill.res index f07d65f143..38382a9e9b 100644 --- a/jscomp/runtime/caml_external_polyfill.ml +++ b/jscomp/runtime/caml_external_polyfill.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,37 +17,35 @@ * 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. *) + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - -type global -let getGlobalThis : unit -> global [@bs]= [%raw{| function(){ +type global +let getGlobalThis: (. unit) => global = %raw(` function(){ if (typeof globalThis !== 'undefined') return globalThis; if (typeof self !== 'undefined') return self; if (typeof window !== 'undefined') return window; if (typeof global !== 'undefined') return global; if (typeof this !== 'undefined') return this; - throw new Error('Unable to locate global `this`'); -}|}] + throw new Error('Unable to locate global this'); +}`) type dyn -let resolve : string -> dyn [@bs] = [%raw {|function(s){ +let resolve: (. string) => dyn = %raw(`function(s){ var myGlobal = getGlobalThis(); if (myGlobal[s] === undefined){ throw new Error(s + " not polyfilled by ReScript yet\n") } return myGlobal[s] -}|}] - -(* FIXME: it does not have to global states *) -type fn +}`) +/* FIXME: it does not have to global states */ +type fn -let register : string -> fn -> unit = [%raw{| function(s,fn){ +let register: (string, fn) => unit = %raw(` function(s,fn){ var myGlobal = getGlobalThis(); myGlobal[s] = fn return 0 -}|}] \ No newline at end of file +}`) diff --git a/jscomp/runtime/caml_float.ml b/jscomp/runtime/caml_float.ml deleted file mode 100644 index dc764810d5..0000000000 --- a/jscomp/runtime/caml_float.ml +++ /dev/null @@ -1,139 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - - -(* borrowed from others/js_math.ml *) -external _LOG2E : float = "Math.LOG2E" [@@bs.val] -external _LOG10E : float = "Math.LOG10E" [@@bs.val] -external abs_float : float -> float = "Math.abs" [@@bs.val] -external floor : float -> float = "Math.floor" [@@bs.val] -external exp : float -> float = "exp" [@@bs.val] [@@bs.scope "Math"] -external log : float -> float = "Math.log" [@@bs.val] -external sqrt : float -> float = "sqrt" [@@bs.val] [@@bs.scope "Math"] -external pow_float : base:float -> exp:float -> float = "Math.pow" [@@bs.val] -external int_of_float : float -> int = "%intoffloat" -external float_of_int : int -> float = "%floatofint" - -let int_float_of_bits : int -> float = [%raw{|function(x){ - return new Float32Array(new Int32Array([x]).buffer)[0] - }|}] -(* let int = Int32_array.make [| x |] in - let float32 = Float32_array.fromBuffer ( Int32_array.buffer int) in - Float32_array.unsafe_get float32 0 *) - -let int_bits_of_float : float -> int = [%raw{|function(x){ - return new Int32Array(new Float32Array([x]).buffer)[0] -}|}] -(* let float32 = Float32_array.make [|x|] in - Int32_array.unsafe_get (Int32_array.fromBuffer (Float32_array.buffer float32)) 0 *) - - -let modf_float (x : float) : float * float = - if Caml_float_extern.isFinite x then - let neg = 1. /. x < 0. in - let x = abs_float x in - let i = floor x in - let f = x -. i in - if neg then - -. f, -. i - else f, i - else if Caml_float_extern.isNaN x then Caml_float_extern._NaN, Caml_float_extern._NaN - else (1. /. x , x) - -let ldexp_float (x: float) (exp: int) : float = - let x', exp' = ref x, ref (float_of_int exp) in - if exp'.contents > 1023. then begin - exp' .contents <- exp'.contents -. 1023.; - x' .contents <- x'.contents *. pow_float ~base:2. ~exp:1023.; - if exp'.contents > 1023. then begin (* in case x is subnormal *) - exp'.contents <- exp'.contents -. 1023.; - x' .contents <- x'.contents *. pow_float ~base:2. ~exp:1023.; - end - end - else if exp'.contents < (-1023.) then begin - exp'.contents <- exp'.contents +. 1023.; - x'.contents <- x'.contents *. pow_float ~base:2. ~exp:(-1023.); - end; - x'.contents *. pow_float ~base:2. ~exp:exp'.contents - - -let frexp_float (x: float): float * int = - if x = 0. || not (Caml_float_extern.isFinite x) then - (x, 0) - else begin - let neg = x < 0. in - let x' = ref (abs_float x) in - let exp = ref (floor (_LOG2E *. log x'.contents) +. 1.) in - begin - x' .contents <- x'.contents *. pow_float ~base:2. ~exp:(-.exp.contents); - if x'.contents < 0.5 then begin - x' .contents <- x'.contents *. 2.; - exp .contents <- exp.contents -. 1.; - end; - if neg then x' .contents <- -.x'.contents; - x'.contents, int_of_float exp.contents - end - end - - - -let copysign_float (x : float) (y : float) : float = - let x = abs_float x in - let y = - if y = 0. then 1. /. y else y in - if y < 0. then -. x else x - -(* http://www.johndcook.com/blog/cpp_expm1/ *) -let expm1_float : float -> float = function x -> - let y = exp x in - let z = y -. 1. in - if abs_float x > 1. then z - else if z = 0. then x else x *. z /. log y - -(* -(* http://blog.csdn.net/liyuanbhu/article/details/8544644 *) -let log1p_float : float -> float = function x -> - let y = 1. +. x in - let z = y -. 1. in - if z = 0. then x else x *. log y /. z *) - - -let hypot_float (x: float) (y: float): float = - let x0, y0 = abs_float x, abs_float y in - let a = Pervasives.max x0 y0 in - let b = Pervasives.min x0 y0 /. if a <> 0. then a else 1. in - a *. sqrt (1. +. b *. b) - - - - -(* -let caml_cosh_float x = exp x +. exp (-. x) /. 2. -let caml_sin_float x = exp x -. exp (-. x) /. 2. -let caml_tan_float x = - let y = exp x in - let z = exp (-. x) in - (y +. z) /. (y -. z ) *) - diff --git a/jscomp/runtime/caml_float.res b/jscomp/runtime/caml_float.res new file mode 100644 index 0000000000..95ac08b3a9 --- /dev/null +++ b/jscomp/runtime/caml_float.res @@ -0,0 +1,157 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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. */ + +/* borrowed from others/js_math.ml */ +@val external _LOG2E: float = "Math.LOG2E" +@val external _LOG10E: float = "Math.LOG10E" +@val external abs_float: float => float = "Math.abs" +@val external floor: float => float = "Math.floor" +@val @scope("Math") external exp: float => float = "exp" +@val external log: float => float = "Math.log" +@val @scope("Math") external sqrt: float => float = "sqrt" +@val external pow_float: (~base: float, ~exp: float) => float = "Math.pow" +external int_of_float: float => int = "%intoffloat" +external float_of_int: int => float = "%floatofint" + +let int_float_of_bits: int => float = %raw(`function(x){ + return new Float32Array(new Int32Array([x]).buffer)[0] + }`) +/* let int = Int32_array.make [| x |] in + let float32 = Float32_array.fromBuffer ( Int32_array.buffer int) in + Float32_array.unsafe_get float32 0 */ + +let int_bits_of_float: float => int = %raw(`function(x){ + return new Int32Array(new Float32Array([x]).buffer)[0] +}`) +/* let float32 = Float32_array.make [|x|] in + Int32_array.unsafe_get (Int32_array.fromBuffer (Float32_array.buffer float32)) 0 */ + +let modf_float = (x: float): (float, float) => + if Caml_float_extern.isFinite(x) { + let neg = 1. /. x < 0. + let x = abs_float(x) + let i = floor(x) + let f = x -. i + if neg { + (-.f, -.i) + } else { + (f, i) + } + } else if Caml_float_extern.isNaN(x) { + (Caml_float_extern._NaN, Caml_float_extern._NaN) + } else { + (1. /. x, x) + } + +let ldexp_float = (x: float, exp: int): float => { + let (x', exp') = (ref(x), ref(float_of_int(exp))) + if exp'.contents > 1023. { + exp'.contents = exp'.contents -. 1023. + x'.contents = x'.contents *. pow_float(~base=2., ~exp=1023.) + if exp'.contents > 1023. { + /* in case x is subnormal */ + exp'.contents = exp'.contents -. 1023. + x'.contents = x'.contents *. pow_float(~base=2., ~exp=1023.) + } + } else if exp'.contents < -1023. { + exp'.contents = exp'.contents +. 1023. + x'.contents = x'.contents *. pow_float(~base=2., ~exp=-1023.) + } + x'.contents *. pow_float(~base=2., ~exp=exp'.contents) +} + +let frexp_float = (x: float): (float, int) => + if x == 0. || !Caml_float_extern.isFinite(x) { + (x, 0) + } else { + let neg = x < 0. + let x' = ref(abs_float(x)) + let exp = ref(floor(_LOG2E *. log(x'.contents)) +. 1.) + + x'.contents = x'.contents *. pow_float(~base=2., ~exp=-.exp.contents) + if x'.contents < 0.5 { + x'.contents = x'.contents *. 2. + exp.contents = exp.contents -. 1. + } + if neg { + x'.contents = -.x'.contents + } + (x'.contents, int_of_float(exp.contents)) + } + +let copysign_float = (x: float, y: float): float => { + let x = abs_float(x) + let y = if y == 0. { + 1. /. y + } else { + y + } + if y < 0. { + -.x + } else { + x + } +} + +/* http://www.johndcook.com/blog/cpp_expm1/ */ +let expm1_float: float => float = x => + switch x { + | x => + let y = exp(x) + let z = y -. 1. + if abs_float(x) > 1. { + z + } else if z == 0. { + x + } else { + x *. z /. log(y) + } + } + +/* +(* http://blog.csdn.net/liyuanbhu/article/details/8544644 *) +let log1p_float : float -> float = function x -> + let y = 1. +. x in + let z = y -. 1. in + if z = 0. then x else x *. log y /. z */ + +let hypot_float = (x: float, y: float): float => { + let (x0, y0) = (abs_float(x), abs_float(y)) + let a = Pervasives.max(x0, y0) + let b = + Pervasives.min(x0, y0) /. if a != 0. { + a + } else { + 1. + } + a *. sqrt(1. +. b *. b) +} + +/* +let caml_cosh_float x = exp x +. exp (-. x) /. 2. +let caml_sin_float x = exp x -. exp (-. x) /. 2. +let caml_tan_float x = + let y = exp x in + let z = exp (-. x) in + (y +. z) /. (y -. z ) */ diff --git a/jscomp/runtime/caml_bytes.mli b/jscomp/runtime/caml_float.resi similarity index 69% rename from jscomp/runtime/caml_bytes.mli rename to jscomp/runtime/caml_float.resi index bb49ed5030..4cb4559b65 100644 --- a/jscomp/runtime/caml_bytes.mli +++ b/jscomp/runtime/caml_float.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,37 +17,23 @@ * 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. *) - - -val create : int -> bytes - -val get : bytes -> int -> char -val set : - bytes -> - int -> - char -> - unit - - - -val bytes_compare: - bytes -> bytes -> int + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -val bytes_greaterthan: - bytes -> bytes -> bool +@val external floor: float => float = "Math.floor" +external int_of_float: float => int = "%intoffloat" +external float_of_int: int => float = "%floatofint" +let int_float_of_bits: int => float +let int_bits_of_float: float => int -val bytes_greaterequal: - bytes -> bytes -> bool +let modf_float: float => (float, float) -val bytes_lessthan: - bytes -> bytes -> bool +let ldexp_float: (float, int) => float +let frexp_float: float => (float, int) -val bytes_lessequal: - bytes -> bytes -> bool +let copysign_float: (float, float) => float +let expm1_float: float => float -val bytes_equal : - bytes -> bytes -> bool \ No newline at end of file +let hypot_float: (float, float) => float diff --git a/jscomp/runtime/caml_float_extern.ml b/jscomp/runtime/caml_float_extern.ml deleted file mode 100644 index ce3d6270ef..0000000000 --- a/jscomp/runtime/caml_float_extern.ml +++ /dev/null @@ -1,7 +0,0 @@ -external _NaN : float = "NaN" [@@bs.val] -external isNaN : float -> bool = "isNaN" [@@bs.val] -external isFinite : float -> bool = "isFinite" [@@bs.val] -external toExponentialWithPrecision : float -> digits:int -> string = "toExponential" [@@bs.send] -external toFixed : float -> string = "toFixed" [@@bs.send] -external toFixedWithPrecision : float -> digits:int -> string = "toFixed" [@@bs.send] -external fromString : string -> float = "Number" [@@bs.val] \ No newline at end of file diff --git a/jscomp/runtime/caml_float_extern.res b/jscomp/runtime/caml_float_extern.res new file mode 100644 index 0000000000..065c5a5aea --- /dev/null +++ b/jscomp/runtime/caml_float_extern.res @@ -0,0 +1,7 @@ +@val external _NaN: float = "NaN" +@val external isNaN: float => bool = "isNaN" +@val external isFinite: float => bool = "isFinite" +@send external toExponentialWithPrecision: (float, ~digits: int) => string = "toExponential" +@send external toFixed: float => string = "toFixed" +@send external toFixedWithPrecision: (float, ~digits: int) => string = "toFixed" +@val external fromString: string => float = "Number" diff --git a/jscomp/runtime/caml_hash.ml b/jscomp/runtime/caml_hash.ml deleted file mode 100644 index 5754f18720..0000000000 --- a/jscomp/runtime/caml_hash.ml +++ /dev/null @@ -1,161 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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-noassertfalse"|]}] -type 'a cell = { - content : 'a ; - mutable next : 'a cell option -} -and 'a t = { - mutable length : int ; - mutable first : 'a cell option; - mutable last : 'a cell option -} - - -let create_queue () = - { - length=0 ; - first = None; - last= None} - -(* Added to tail *) -let push_back (q :'a t) (v : 'a) = - let cell = - Some - {content=v ; next=None} - in - match q.last with - | None -> - q . length<- 1 ; - q . first <- cell; - q . last <- cell - | Some last -> - q . length <- q . length + 1; - last . next <- cell; - q . last <- cell - -let is_empty_queue q = q.length = 0 - -(* pop from front *) - - -let unsafe_pop (q : 'a t) = - match q.first with - | None -> assert false - | Some cell -> - let next =cell.next in - if next = None then ( - q . length <- 0 ; - q . first <- None; - q . last<- None; - ) else ( - q . length <- q . length - 1; - q . first <- next; - ); - cell.content - - - -let {hash_mix_int ; - hash_final_mix ; - hash_mix_string - } = (module Caml_hash_primitive) - - -let hash (count : int) _limit (seed : int) - (obj : Obj.t) : int = - let s = ref seed in - if Js.typeof obj = "number" then - begin - let u = Caml_nativeint_extern.of_float (Obj.magic obj) in - s.contents <- hash_mix_int s.contents (u + u + 1) ; - hash_final_mix s.contents - end - else if Js.typeof obj = "string" then - begin - s.contents <- hash_mix_string s.contents (Obj.magic obj : string); - hash_final_mix s.contents - end - (* TODO: hash [null] [undefined] as well *) - else - - let queue = create_queue () in - let num = ref count in - let () = - push_back queue obj; - num.contents <- num.contents - 1 - in - while not ( is_empty_queue queue) && num.contents > 0 do - let obj = unsafe_pop queue in - if Js.typeof obj = "number" then - begin - let u = Caml_nativeint_extern.of_float (Obj.magic obj) in - s.contents <- hash_mix_int s.contents (u + u + 1) ; - num.contents <- num.contents - 1; - end - else if Js.typeof obj = "string" then - begin - s.contents <- hash_mix_string s.contents (Obj.magic obj : string); - num.contents <- num.contents - 1 - end - else if Js.typeof obj = "boolean" then - () - else if Js.typeof obj = "undefined" then - () - else if Js.typeof obj = "symbol" then - () - else if Js.typeof obj = "function" then - () - else - let size = Obj.size obj in - if size <> 0 then begin - let obj_tag = Obj.tag obj in - let tag = (size lsl 10) lor obj_tag in - if obj_tag = 248 (* Obj.object_tag*) then - s.contents <- hash_mix_int s.contents - (Obj.obj (Obj.field obj 1) : int) - else - begin - s.contents <- hash_mix_int s.contents tag ; - let block = - let v = size - 1 in if v < num.contents then v else num.contents in - for i = 0 to block do - push_back queue (Obj.field obj i ) - done - end - end else - begin - let size : int = ([%raw {|function(obj,cb){ - var size = 0 - for(var k in obj){ - cb(obj[k]) - ++ size - } - return size - }|}] obj (fun [@bs] v -> push_back queue v ) [@bs]) in - s.contents <- hash_mix_int s.contents ((size lsl 10) lor 0) (*tag*) ; - end - done; - hash_final_mix s.contents - diff --git a/jscomp/runtime/caml_hash.res b/jscomp/runtime/caml_hash.res new file mode 100644 index 0000000000..60542c5d69 --- /dev/null +++ b/jscomp/runtime/caml_hash.res @@ -0,0 +1,151 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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-noassertfalse"]}) +type rec cell<'a> = { + content: 'a, + mutable next: option>, +} +and t<'a> = { + mutable length: int, + mutable first: option>, + mutable last: option>, +} + +let create_queue = () => { + length: 0, + first: None, + last: None, +} + +/* Added to tail */ +let push_back = (q: t<'a>, v: 'a) => { + let cell = Some({content: v, next: None}) + + switch q.last { + | None => + q.length = 1 + q.first = cell + q.last = cell + | Some(last) => + q.length = q.length + 1 + last.next = cell + q.last = cell + } +} + +let is_empty_queue = q => q.length == 0 + +/* pop from front */ + +let unsafe_pop = (q: t<'a>) => + switch q.first { + | None => assert(false) + | Some(cell) => + let next = cell.next + if next == None { + q.length = 0 + q.first = None + q.last = None + } else { + q.length = q.length - 1 + q.first = next + } + cell.content + } + +let {hash_mix_int, hash_final_mix, hash_mix_string} = module(Caml_hash_primitive) + +let hash = (count: int, _limit, seed: int, obj: Obj.t): int => { + let s = ref(seed) + if Js.typeof(obj) == "number" { + let u = Caml_nativeint_extern.of_float(Obj.magic(obj)) + s.contents = hash_mix_int(s.contents, u + u + 1) + hash_final_mix(s.contents) + } else if Js.typeof(obj) == "string" { + s.contents = hash_mix_string(s.contents, (Obj.magic(obj): string)) + hash_final_mix(s.contents) + } else { + /* TODO: hash [null] [undefined] as well */ + + let queue = create_queue() + let num = ref(count) + let () = { + push_back(queue, obj) + num.contents = num.contents - 1 + } + + while !is_empty_queue(queue) && num.contents > 0 { + let obj = unsafe_pop(queue) + if Js.typeof(obj) == "number" { + let u = Caml_nativeint_extern.of_float(Obj.magic(obj)) + s.contents = hash_mix_int(s.contents, u + u + 1) + num.contents = num.contents - 1 + } else if Js.typeof(obj) == "string" { + s.contents = hash_mix_string(s.contents, (Obj.magic(obj): string)) + num.contents = num.contents - 1 + } else if Js.typeof(obj) == "boolean" { + () + } else if Js.typeof(obj) == "undefined" { + () + } else if Js.typeof(obj) == "symbol" { + () + } else if Js.typeof(obj) == "function" { + () + } else { + let size = Obj.size(obj) + if size != 0 { + let obj_tag = Obj.tag(obj) + let tag = lor(lsl(size, 10), obj_tag) + if obj_tag == 248 /* Obj.object_tag */ { + s.contents = hash_mix_int(s.contents, (Obj.obj(Obj.field(obj, 1)): int)) + } else { + s.contents = hash_mix_int(s.contents, tag) + let block = { + let v = size - 1 + if v < num.contents { + v + } else { + num.contents + } + } + for i in 0 to block { + push_back(queue, Obj.field(obj, i)) + } + } + } else { + let size: int = %raw(`function(obj,cb){ + var size = 0 + for(var k in obj){ + cb(obj[k]) + ++ size + } + return size + }`)(.obj, (. v) => push_back(queue, v)) + s.contents = hash_mix_int(s.contents, lor(lsl(size, 10), 0)) /* tag */ + } + } + } + hash_final_mix(s.contents) + } +} diff --git a/jscomp/runtime/caml_md5.mli b/jscomp/runtime/caml_hash.resi similarity index 90% rename from jscomp/runtime/caml_md5.mli rename to jscomp/runtime/caml_hash.resi index b70ff88f0c..da8fd9e1b6 100644 --- a/jscomp/runtime/caml_md5.mli +++ b/jscomp/runtime/caml_hash.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,15 +17,9 @@ * 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. *) - - - - -(** *) - -val md5_string : string -> int -> int -> string + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +let hash: (int, 'a, int, Obj.t) => int diff --git a/jscomp/runtime/caml_hash_primitive.ml b/jscomp/runtime/caml_hash_primitive.ml deleted file mode 100644 index 33d9747d20..0000000000 --- a/jscomp/runtime/caml_hash_primitive.ml +++ /dev/null @@ -1,84 +0,0 @@ -(* Copyright (C) 2018 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. *) - - - - - - -let rotl32 (x : int) n = - (x lsl n) lor (x lsr (32 - n)) - -external (.![]) : string -> int -> int = "charCodeAt" [@@bs.send] -let hash_mix_int h d = - let d = ref d in - d.contents <- d.contents * 0xcc9e2d51 ; - d.contents <- rotl32 d.contents 15 ; - d.contents <- d.contents * 0x1b873593 ; - let h = ref (h lxor d.contents) in - h.contents <- rotl32 h.contents 13 ; - h.contents + (h.contents lsl 2) + 0xe6546b64 - -let hash_final_mix h = - let h = ref (h lxor (h lsr 16)) in - h.contents <- h.contents * 0x85ebca6b ; - h.contents <- h.contents lxor (h.contents lsr 13); - h.contents <- h.contents * 0xc2b2ae35 ; - h.contents lxor (h.contents lsr 16) -(* Caml_nativeint_extern.logand (h.contents ^ (h.contents >>> 16)) 0x3FFFFFFFn *) - -let hash_mix_string h s = - - let len =Caml_string_extern.length s in - let block = len / 4 - 1 in - let hash = ref h in - for i = 0 to block do - let j = 4 * i in - let w = - s.![j] lor - (s.![j+1] lsl 8) lor - (s.![j+2] lsl 16) lor - (s.![j+3] lsl 24) - in - hash.contents <- hash_mix_int hash.contents w - done ; - let modulo = len land 0b11 in - if modulo <> 0 then - begin - let w = - if modulo = 3 then - (s.![len - 1] lsl 16) lor - (s.![len - 2] lsl 8) lor - s.![len - 3] - else if modulo = 2 then - (s.![len -1] lsl 8) lor - s.![len -2] - else s.![len - 1] - in - hash.contents <- hash_mix_int hash.contents w - end; - hash.contents <- hash.contents lxor len ; - hash.contents - - diff --git a/jscomp/runtime/caml_hash_primitive.mli b/jscomp/runtime/caml_hash_primitive.mli deleted file mode 100644 index 414ee84e5e..0000000000 --- a/jscomp/runtime/caml_hash_primitive.mli +++ /dev/null @@ -1,27 +0,0 @@ -(* 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. *) - -val hash_mix_int : int -> int -> int -val hash_mix_string : int -> string -> int -val hash_final_mix : int -> int diff --git a/jscomp/runtime/caml_hash_primitive.res b/jscomp/runtime/caml_hash_primitive.res new file mode 100644 index 0000000000..281b623168 --- /dev/null +++ b/jscomp/runtime/caml_hash_primitive.res @@ -0,0 +1,78 @@ +/* Copyright (C) 2018 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. */ + +let rotl32 = (x: int, n) => lor(lsl(x, n), lsr(x, 32 - n)) + +@send external charCodeAt: (string, int) => int = "charCodeAt" + +let hash_mix_int = (h, d) => { + let d = ref(d) + d.contents = d.contents * 0xcc9e2d51 + d.contents = rotl32(d.contents, 15) + d.contents = d.contents * 0x1b873593 + let h = ref(lxor(h, d.contents)) + h.contents = rotl32(h.contents, 13) + h.contents + lsl(h.contents, 2) + 0xe6546b64 +} + +let hash_final_mix = h => { + let h = ref(lxor(h, lsr(h, 16))) + h.contents = h.contents * 0x85ebca6b + h.contents = lxor(h.contents, lsr(h.contents, 13)) + h.contents = h.contents * 0xc2b2ae35 + lxor(h.contents, lsr(h.contents, 16)) +} +/* Caml_nativeint_extern.logand (h.contents ^ (h.contents >>> 16)) 0x3FFFFFFFn */ + +let hash_mix_string = (h, s) => { + let len = Caml_string_extern.length(s) + let block = len / 4 - 1 + let hash = ref(h) + for i in 0 to block { + let j = 4 * i + let w = lor( + lor(lor(s->charCodeAt(j), lsl(s->charCodeAt(j + 1), 8)), lsl(s->charCodeAt(j + 2), 16)), + lsl(s->charCodeAt(j + 3), 24), + ) + + hash.contents = hash_mix_int(hash.contents, w) + } + let modulo = land(len, 0b11) + if modulo != 0 { + let w = if modulo == 3 { + lor( + lor(lsl(s->charCodeAt(len - 1), 16), lsl(s->charCodeAt(len - 2), 8)), + s->charCodeAt(len - 3), + ) + } else if modulo == 2 { + lor(lsl(s->charCodeAt(len - 1), 8), s->charCodeAt(len - 2)) + } else { + s->charCodeAt(len - 1) + } + + hash.contents = hash_mix_int(hash.contents, w) + } + hash.contents = lxor(hash.contents, len) + hash.contents +} diff --git a/jscomp/runtime/caml_hash_primitive.resi b/jscomp/runtime/caml_hash_primitive.resi new file mode 100644 index 0000000000..7066bf46f2 --- /dev/null +++ b/jscomp/runtime/caml_hash_primitive.resi @@ -0,0 +1,27 @@ +/* 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. */ + +let hash_mix_int: (int, int) => int +let hash_mix_string: (int, string) => int +let hash_final_mix: int => int diff --git a/jscomp/runtime/caml_int32.ml b/jscomp/runtime/caml_int32.res similarity index 79% rename from jscomp/runtime/caml_int32.ml rename to jscomp/runtime/caml_int32.res index 13e48161bc..bba66cf586 100644 --- a/jscomp/runtime/caml_int32.ml +++ b/jscomp/runtime/caml_int32.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,23 +17,21 @@ * 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. *) - - - - - - -let div (x:int) (y:int) = - if y = 0 then - raise Division_by_zero - else Caml_nativeint_extern.div x y - -let mod_ (x : int) (y:int) = - if y = 0 then - raise Division_by_zero - else Caml_nativeint_extern.rem x y - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +let div = (x: int, y: int) => + if y == 0 { + raise(Division_by_zero) + } else { + Caml_nativeint_extern.div(x, y) + } + +let mod_ = (x: int, y: int) => + if y == 0 { + raise(Division_by_zero) + } else { + Caml_nativeint_extern.rem(x, y) + } diff --git a/jscomp/runtime/caml_hash.mli b/jscomp/runtime/caml_int32.resi similarity index 90% rename from jscomp/runtime/caml_hash.mli rename to jscomp/runtime/caml_int32.resi index 2efaad6d2a..56ef48535e 100644 --- a/jscomp/runtime/caml_hash.mli +++ b/jscomp/runtime/caml_int32.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,13 +17,11 @@ * 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. *) - - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +let div: (int, int) => int -(** *) -val hash : int -> 'a -> int -> Obj.t -> int +let mod_: (int, int) => int diff --git a/jscomp/runtime/caml_int64.ml b/jscomp/runtime/caml_int64.ml deleted file mode 100644 index b2ce49540c..0000000000 --- a/jscomp/runtime/caml_int64.ml +++ /dev/null @@ -1,531 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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 would only work with js backend, since it requires - [int] behaves as js numbers -*) - -(* TODO: see GPR#333 - the encoding of int is platform dependent *) - - - - -let %private -{ - shift_right_logical = (>>>~); - add = (+~); - mul = ( *~ ) -} = - (module Caml_nativeint_extern) - -let {i64_eq = eq ; - i64_ge = ge; - i64_gt = gt; - } = (module Caml) - -let lognot x = x lxor (-1) - -(* [hi] is signed - [lo] is unsigned - - signedness does not matter when they are doing int32 bits operation - however, they are different when doing comparison -*) -type t = Caml_int64_extern.t = { - hi : int ; [@as "0"] lo : int ; [@as "1" ] -} - -external unsafe_to_int64 : t -> int64 = "%identity" -external unsafe_of_int64 : int64 -> t = "%identity" - - -let [@inline] mk ~lo ~hi = {lo = lo >>>~ 0 ; hi} -let min_int = mk ~lo: 0 ~hi:(0x80000000) -(* The high bits are signed 0x80000000 |~ 0 *) - -let max_int = - mk ~lo:(0xffff_ffff) ~hi: 0x7fff_ffff - -let one = mk ~lo: 1 ~hi:0 -let zero = mk ~lo: 0 ~hi: 0 -let neg_one = mk ~lo:(-1) ~hi:(-1) - - - -let neg_signed x = (x land 0x8000_0000) <> 0 -let non_neg_signed x = (x land 0x8000_0000) = 0 -let succ_aux ~x_lo ~x_hi = - let lo = ( x_lo +~ 1) lor 0 in - mk ~lo ~hi:(( x_hi +~ if lo = 0 then 1 else 0) lor 0) -let succ ( {lo = x_lo; hi = x_hi} : t) = - succ_aux ~x_lo ~x_hi - -let neg ( {lo;hi} ) = - let other_lo = (lognot lo +~ 1) lor 0 in - mk ~lo:other_lo - ~hi:((lognot hi +~ if other_lo = 0 then 1 else 0) lor 0) - - - - - - -let add_aux - ( {lo = x_lo; hi = x_hi} : t) - ~y_lo ~y_hi = - let lo = ( x_lo +~ y_lo) lor 0 in - let overflow = - if (neg_signed x_lo && ( neg_signed y_lo || (non_neg_signed lo))) - || (neg_signed y_lo && (non_neg_signed lo)) - (* we can make it symmetric by adding (neg_signed x_lo) but it will make it - verbose and slow - a (b+c) + b (a+c) - --> bc + ac + ab - --> a (b+c) + bc - *) - then 1 - else 0 - in - mk ~lo ~hi:(( x_hi +~ y_hi +~ overflow) lor 0) - - -let add - (self : t) - ( {lo = y_lo; hi = y_hi} : t) = - add_aux self ~y_lo ~y_hi - - -(* let not ( {lo; hi }) = mk ~lo:(lognot lo) ~hi:(lognot hi) *) - - -let equal x y = x.lo = y.lo && x.hi =y.hi -let equal_null x y = - match Js.nullToOption y with - | None -> false - | Some y -> eq x y -let equal_undefined x y = - match Js.undefinedToOption y with - | None -> false - | Some y -> eq x y -let equal_nullable x y = - match Js.toOption y with - | None -> false - | Some y -> eq x y - - - -(* when [lo] is unsigned integer, [lognot lo] is still an unsigned integer *) -let sub_aux x ~lo ~hi = - let y_lo = (lognot lo +~ 1) >>>~ 0 in - let y_hi = ((lognot hi +~ if y_lo = 0 then 1 else 0) lor 0) in - add_aux x ~y_lo ~y_hi - -let sub self ({lo;hi})= sub_aux self ~lo ~hi - - -let lsl_ ( {lo; hi} as x) numBits = - if numBits = 0 then - x - else if numBits >= 32 then - mk ~lo:0 ~hi:(lo lsl (numBits - 32)) - else - mk ~lo:(lo lsl numBits) - ~hi: - ( - ( lo >>>~ (32 - numBits)) lor - ( hi lsl numBits)) - - -let lsr_ ( {lo; hi} as x) numBits = - if numBits = 0 then x - else - let offset = numBits - 32 in - if offset = 0 then - mk ~lo:hi ~hi:0 - else if offset > 0 then - mk ~lo:(hi >>>~ offset) ~hi:0 - else - mk - ~hi: ( hi >>>~ numBits) - ~lo:( - (hi lsl (-offset)) - lor - ( lo >>>~ numBits)) - - -let asr_ ( {lo; hi } as x) numBits = - if numBits = 0 then - x - else - if numBits < 32 then - mk ~hi:( hi asr numBits) - ~lo:( - ( hi lsl (32 - numBits)) (* zero filled *) - lor - ( lo >>>~ numBits)) - - - else - mk ~hi:( if hi >= 0 then 0 else -1) ~lo:( hi asr (numBits - 32)) - - -let is_zero = function - | {lo = 0 ; hi = 0} -> true - | _ -> false - - - -let rec mul this - other = - match this, other with - | {lo = 0 ; hi = 0}, _ - | _, {lo = 0; hi = 0} - -> zero - | {lo = 0; hi = - 0x80000000}, {lo;_ } - | {lo;_}, {lo = 0; hi = - 0x80000000} - -> - if lo land 0x1 = 0 then - zero - else min_int - | {lo = this_lo; hi = this_hi}, - {lo = other_lo; hi = other_hi } - -> - if this_hi < 0 then - if other_hi < 0 then - mul (neg this) (neg other) - else - neg (mul (neg this) other) - else if other_hi < 0 then - neg (mul this (neg other) ) - else - (* TODO: when both are small, use float multiplication *) - let a48 = this_hi >>>~ 16 in - let a32 = this_hi land 0xffff in - let a16 = this_lo >>>~ 16 in - let a00 = this_lo land 0xffff in - - let b48 = other_hi >>>~ 16 in - let b32 = other_hi land 0xffff in - let b16 = other_lo >>>~ 16 in - let b00 = other_lo land 0xffff in - - let c48 = ref 0 in - let c32 = ref 0 in - let c16 = ref 0 in - begin - let c00 = a00 *~ b00 in - c16.contents <- (c00 >>>~ 16) +~ a16 *~ b00 ; - c32.contents <- c16.contents >>>~ 16; - c16.contents <- ( c16.contents land 0xffff) +~ a00 *~ b16; - c32.contents <- (c32.contents +~ ( c16.contents >>>~ 16)) +~ a32 *~ b00; - c48.contents <- c32.contents >>>~ 16; - c32.contents <- (c32.contents land 0xffff) +~ a16 *~ b16; - c48.contents <- c48.contents +~ ( c32.contents >>>~ 16); - c32.contents <- (c32.contents land 0xffff) +~ a00 *~ b32; - c48.contents <- c48.contents +~ (c32.contents >>>~ 16); - c32.contents <- c32.contents land 0xffff; - c48.contents <- (c48.contents +~ (a48 *~ b00 +~ a32 *~ b16 +~ a16 *~ b32 +~ a00 *~ b48)) land 0xffff; - mk ~lo: - ( - (c00 land 0xffff) lor - ( (c16.contents land 0xffff) lsl 16)) - ~hi:( - c32.contents lor - ( c48.contents lsl 16)) - - end - - - - - -(* Dispatched by the compiler, idea: should we do maximum sharing -*) -let xor ( {lo = this_lo; hi= this_hi}) ( {lo = other_lo; hi = other_hi}) = - mk - ~lo:(this_lo lxor other_lo) - ~hi:(this_hi lxor other_hi) - - -let or_ ( {lo = this_lo; hi= this_hi}) ( {lo = other_lo; hi = other_hi}) = - mk - ~lo:(this_lo lor other_lo ) - ~hi:(this_hi lor other_hi) - -let and_ ( {lo = this_lo; hi= this_hi}) ( {lo = other_lo; hi = other_hi}) = - mk - ~lo:(this_lo land other_lo) - ~hi:(this_hi land other_hi) - - - -(* TODO: if we encode lo int32 bit as unsigned then - this is not necessary, - however (x>>>0 >>>0) is not that bad -*) - - - - - - - -let to_float ( {hi; lo} : t) = - Caml_nativeint_extern.to_float ( hi *~ [%raw{|0x100000000|}] +~ lo) - - - - -(** sign: Positive - -FIXME: hex notation -*) -let two_ptr_32_dbl = 4294967296. (* 2. ** 32*) -let two_ptr_63_dbl = 9.22337203685477581e+18 (* 2. ** 63.*) -let neg_two_ptr_63 = -9.22337203685477581e+18 (*-. (2. ** 63.)*) - -external mod_float : float -> float -> float = "?fmod_float" -(* note that we make sure the const number can acutally be represented - {[ - (2. ** 63. -. 1. = 2. ** 63.) ;; - ]} -*) - - -let rec of_float (x : float) : t = - if Caml_float_extern.isNaN x - || Pervasives.not (Caml_float_extern.isFinite x ) then zero - else if x <= neg_two_ptr_63 then - min_int - else if x +. 1. >= two_ptr_63_dbl then - max_int (* Undefined behavior *) - else if x < 0. then - neg (of_float (-. x)) - else mk ~lo:(Caml_nativeint_extern.of_float (mod_float x two_ptr_32_dbl)) - ~hi:(Caml_nativeint_extern.of_float (x /. two_ptr_32_dbl)) - - -external log2 : float = "LN2" [@@bs.val] [@@bs.scope "Math"] -external log : float -> float = "log" [@@bs.val] [@@bs.scope "Math"] -external ceil : float -> float = "ceil" [@@bs.val] [@@bs.scope "Math"] -external floor : float -> float = "floor" [@@bs.val] [@@bs.scope "Math"] -(* external maxFloat : float -> float -> float = "Math.max" [@@bs.val] *) - -(* either top 11 bits are all 0 or all 1 - when it is all 1, we need exclude -2^53 -*) -let isSafeInteger ({hi;lo}) = - let top11Bits = hi asr 21 in - top11Bits = 0 || - (top11Bits = -1 && - Pervasives.not (lo = 0 && hi = 0xff_e0_00_00)) - -external string_of_float : float -> string = "String" [@@bs.val] -let rec to_string ( self : int64) = - let ({hi=self_hi;_} as self) = unsafe_of_int64 self in - if isSafeInteger self then - string_of_float (to_float self) - else - - if self_hi <0 then - if eq self min_int then "-9223372036854775808" - else "-" ^ to_string (unsafe_to_int64 (neg self)) - else (* large positive number *) - let ( {lo ; hi} as approx_div1) = (of_float (floor (to_float self /. 10.) )) in - let ( { lo = rem_lo ;hi = rem_hi} ) = (* rem should be a pretty small number *) - self - |. sub_aux ~lo:(lo lsl 3) ~hi:((lo>>>~29) lor (hi lsl 3)) - |. sub_aux ~lo:(lo lsl 1) ~hi: ((lo >>>~ 31) lor (hi lsl 1)) - in - if rem_lo =0 && rem_hi = 0 then to_string (unsafe_to_int64 approx_div1) ^ "0" - else - if rem_hi < 0 then - (* let ( {lo = rem_lo}) = neg rem in *) - let rem_lo = (lognot rem_lo +~ 1 ) >>>~ 0 |. Caml_nativeint_extern.to_float in - let delta = (ceil (rem_lo /. 10.)) in - let remainder = 10. *. delta -. rem_lo in - ( - approx_div1 - |. sub_aux ~lo:(Caml_nativeint_extern.of_float delta) ~hi:0 - |. unsafe_to_int64 - |. to_string - ) ^ - Caml_nativeint_extern.to_string (Caml_nativeint_extern.of_float remainder) - else - let rem_lo = Caml_nativeint_extern.to_float rem_lo in - let delta = (floor (rem_lo /. 10.)) in - let remainder = rem_lo -. 10. *. delta in - (approx_div1 - |. add_aux ~y_lo:(Caml_nativeint_extern.of_float delta) ~y_hi:0 - |. unsafe_to_int64 - |. to_string) - ^ - Caml_nativeint_extern.to_string (Caml_nativeint_extern.of_float remainder) - - -let [@inline] float_max (a : float) b = - if a > b then a else b -let rec div self other = - match self, other with - | _, {lo = 0 ; hi = 0} -> - raise Division_by_zero - | {lo = 0; hi = 0}, _ - -> zero - | {lo = 0 ; hi = -0x8000_0000}, _ - -> - begin - if eq other one || eq other neg_one then self - else if eq other min_int then one - else - let ( {hi = other_hi;_}) = other in - (* now |other| >= 2, so |this/other| < |MIN_VALUE|*) - let half_this = asr_ self 1 in - let approx = lsl_ (div half_this other) 1 in - match approx with - | {lo = 0 ; hi = 0} - -> if other_hi < 0 then one else neg one - | _ - -> - let rem = sub self (mul other approx) in - add approx (div rem other) - end - | _, {lo = 0; hi = - 0x8000_0000} - -> zero - | {lo = _; hi = self_hi}, {lo = _; hi = other_hi} - -> - if self_hi < 0 then - if other_hi <0 then - div (neg self) (neg other) - else - neg (div (neg self) other) - else if other_hi < 0 then - neg (div self (neg other)) - else - let res = ref zero in - let rem = ref self in - (* assert false *) - while ge rem.contents other do - let approx = ref ( float_max 1. - (Caml_float.floor (to_float rem.contents /. to_float other) )) in - let log2 = ceil (log approx.contents /. log2) in - let delta = - if log2 <= 48. then 1. - else 2. ** (log2 -. 48.) in - let approxRes = ref (of_float approx.contents) in - let approxRem = ref (mul approxRes.contents other) in - while (match approxRem.contents with {hi;_}-> hi) < 0 || gt approxRem.contents rem.contents do - approx.contents <- approx.contents -. delta; - approxRes.contents <- of_float approx.contents; - approxRem.contents <- mul approxRes.contents other - done; - (if is_zero approxRes.contents then - approxRes.contents <- one); - res.contents <- add res.contents approxRes.contents; - rem.contents <- sub rem.contents approxRem.contents - done; - res.contents - -let mod_ self other = - sub self (mul (div self other) other) - - -let div_mod (self : int64) (other : int64) : int64 * int64 = - let quotient = div (unsafe_of_int64 self) (unsafe_of_int64 other) in - unsafe_to_int64 quotient, unsafe_to_int64 (sub (unsafe_of_int64 self) (mul quotient (unsafe_of_int64 other))) - -(** Note this function is unasfe here, but when combined it is actually safe - In theory, we need do an uint_compare for [lo] components - The thing is [uint_compare] and [int_compare] are specialised - to the same code when translted into js -*) -let [@inline] int_compare (x : int) y = - if x < y then -1 else if x = y then 0 else 1 - -let compare ( self) ( other) = - let v = int_compare self.hi other.hi in - if v = 0 then - int_compare self.lo other.lo - else v - -let of_int32 (lo : int) = - mk ~lo ~hi:(if lo < 0 then -1 else 0) - -let to_int32 ( x) = x.lo lor 0 (* signed integer *) - - -(* width does matter, will it be relevant to endian order? *) - -let to_hex (x : int64) = - let {hi = x_hi; lo = x_lo} = unsafe_of_int64 x in - let aux v : string = - Caml_string_extern.of_int (Caml_nativeint_extern.shift_right_logical v 0) ~base:16 - in - match x_hi, x_lo with - | 0, 0 -> "0" - | _, 0 -> aux x_hi ^ "00000000" - | 0, _ -> aux x_lo - | _, _ -> - let lo = aux x_lo in - let pad = 8 -Caml_string_extern.length lo in - if pad <= 0 then - aux x_hi ^ lo - else - aux x_hi ^ Caml_string_extern.repeat "0" pad ^ lo - - -let discard_sign (x : int64) : int64 = - let v = unsafe_of_int64 x in - unsafe_to_int64 - (match v with v -> { v with hi = 0x7fff_ffff land v.hi }) - -(* >>> 0 does not change its bit representation - it simply makes sure it is an unsigned integer - -1 >>> 0 -> 4294967295 - Which is still (-1) if you interpret it as a signed integer - When we do the call (new Int32Array(x[1], x[0]), it will - convert x[0] from an unsigned integer to signed integer - {[ - new Int32Array([-1 >>> 0]) - Int32Array(1)[-1] - ]} -*) - -let float_of_bits ( x : t) : float = - ([%raw{|function(lo,hi){ return (new Float64Array(new Int32Array([lo,hi]).buffer))[0]}|}] : _ -> _ -> _ ) x.lo x.hi - -(* let to_int32 (x : nativeint) = x |> Caml_nativeint_extern.to_int32 - in - (*TODO: - This should get inlined, we should apply a simple inliner in the js layer, - the thing is its lambda representation is complex but after js layer, - it's qutie simple - *) - let int32 = Int32_array.make [| to_int32 x.lo; to_int32 x.hi |] in - Float64_array.unsafe_get (Float64_array.fromBuffer (Int32_array.buffer int32)) 0 *) - -let bits_of_float : float -> t = fun x -> - let lo,hi = ([%raw{|function(x){return new Int32Array(new Float64Array([x]).buffer)}|}] : _ -> _) x in - mk ~lo ~hi diff --git a/jscomp/runtime/caml_int64.mli b/jscomp/runtime/caml_int64.mli deleted file mode 100644 index b9fc46e3b2..0000000000 --- a/jscomp/runtime/caml_int64.mli +++ /dev/null @@ -1,88 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - - - - -(** *) - -type t -val mk : - lo:int -> hi:int -> t -val succ : t -> t -val min_int : t -val max_int : t -val one : t -val zero : t -val neg_one : t -(* val not : t -> t *) -val of_int32 : int -> t -val to_int32 : t -> int - -val add : t -> t -> t -val neg : t -> t -val sub : t -> t -> t -val lsl_ : t -> int -> t -val lsr_ : t -> int -> t -val asr_ : t -> int -> t -val is_zero : t -> bool -val mul : t -> t -> t -val xor : t -> t -> t -val or_ : t -> t -> t -val and_ : t -> t -> t - - - - -val equal : t -> t -> bool -val equal_null : t -> t Js.null -> bool -val equal_undefined : t -> t Js.undefined -> bool -val equal_nullable : t -> t Js.nullable -> bool - - -val to_float : t -> float -val of_float : float -> t -val div : t -> t -> t -val mod_ : t -> t -> t - - -val compare : t -> t -> int - - - -val float_of_bits : t -> float - -(** [bits_of_float fl] it is undefined behaivor when [f] is NaN*) -val bits_of_float : float -> t - -(* val get64 : string -> int -> t *) - - -external unsafe_to_int64 : t -> int64 = "%identity" -external unsafe_of_int64 : int64 -> t = "%identity" -val div_mod : int64 -> int64 -> int64 * int64 -val to_hex : int64 -> string -val discard_sign : int64 -> int64 -val to_string : int64 -> string \ No newline at end of file diff --git a/jscomp/runtime/caml_int64.res b/jscomp/runtime/caml_int64.res new file mode 100644 index 0000000000..7958282981 --- /dev/null +++ b/jscomp/runtime/caml_int64.res @@ -0,0 +1,564 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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 would only work with js backend, since it requires + [int] behaves as js numbers +*/ + +/* TODO: see GPR#333 + the encoding of int is platform dependent */ + +%%private( + let {shift_right_logical: \">>>~", add: \"+~", mul: \"*~"} = module(Caml_nativeint_extern) +) + +let {i64_eq: eq, i64_ge: ge, i64_gt: gt} = module(Caml) + +let lognot = x => lxor(x, -1) + +/* [hi] is signed + [lo] is unsigned + + signedness does not matter when they are doing int32 bits operation + however, they are different when doing comparison +*/ +type t = Caml_int64_extern.t = {@as("0") hi: int, @as("1") lo: int} + +external unsafe_to_int64: t => int64 = "%identity" +external unsafe_of_int64: int64 => t = "%identity" + +@inline let mk = (~lo, ~hi) => {lo: \">>>~"(lo, 0), hi} +let min_int = mk(~lo=0, ~hi=0x80000000) +/* The high bits are signed 0x80000000 |~ 0 */ + +let max_int = mk(~lo=0xffff_ffff, ~hi=0x7fff_ffff) + +let one = mk(~lo=1, ~hi=0) +let zero = mk(~lo=0, ~hi=0) +let neg_one = mk(~lo=-1, ~hi=-1) + +let neg_signed = x => land(x, 0x8000_0000) != 0 +let non_neg_signed = x => land(x, 0x8000_0000) == 0 +let succ_aux = (~x_lo, ~x_hi) => { + let lo = lor(\"+~"(x_lo, 1), 0) + mk( + ~lo, + ~hi=lor( + \"+~"( + x_hi, + if lo == 0 { + 1 + } else { + 0 + }, + ), + 0, + ), + ) +} +let succ = ({lo: x_lo, hi: x_hi}: t) => succ_aux(~x_lo, ~x_hi) + +let neg = ({lo, hi}) => { + let other_lo = lor(\"+~"(lognot(lo), 1), 0) + mk( + ~lo=other_lo, + ~hi=lor( + \"+~"( + lognot(hi), + if other_lo == 0 { + 1 + } else { + 0 + }, + ), + 0, + ), + ) +} + +let add_aux = ({lo: x_lo, hi: x_hi}: t, ~y_lo, ~y_hi) => { + let lo = lor(\"+~"(x_lo, y_lo), 0) + let overflow = if ( + (neg_signed(x_lo) && (neg_signed(y_lo) || non_neg_signed(lo))) || + (neg_signed(y_lo) && non_neg_signed(lo)) + ) { + /* we can make it symmetric by adding (neg_signed x_lo) but it will make it + verbose and slow + a (b+c) + b (a+c) + --> bc + ac + ab + --> a (b+c) + bc + */ + 1 + } else { + 0 + } + + mk(~lo, ~hi=lor(\"+~"(\"+~"(x_hi, y_hi), overflow), 0)) +} + +let add = (self: t, {lo: y_lo, hi: y_hi}: t) => add_aux(self, ~y_lo, ~y_hi) + +/* let not ( {lo; hi }) = mk ~lo:(lognot lo) ~hi:(lognot hi) */ + +let equal = (x, y) => x.lo == y.lo && x.hi == y.hi +let equal_null = (x, y) => + switch Js.nullToOption(y) { + | None => false + | Some(y) => eq(x, y) + } +let equal_undefined = (x, y) => + switch Js.undefinedToOption(y) { + | None => false + | Some(y) => eq(x, y) + } +let equal_nullable = (x, y) => + switch Js.toOption(y) { + | None => false + | Some(y) => eq(x, y) + } + +/* when [lo] is unsigned integer, [lognot lo] is still an unsigned integer */ +let sub_aux = (x, ~lo, ~hi) => { + let y_lo = \">>>~"(\"+~"(lognot(lo), 1), 0) + let y_hi = lor( + \"+~"( + lognot(hi), + if y_lo == 0 { + 1 + } else { + 0 + }, + ), + 0, + ) + add_aux(x, ~y_lo, ~y_hi) +} + +let sub = (self, {lo, hi}) => sub_aux(self, ~lo, ~hi) + +let lsl_ = ({lo, hi} as x, numBits) => + if numBits == 0 { + x + } else if numBits >= 32 { + mk(~lo=0, ~hi=lsl(lo, numBits - 32)) + } else { + mk(~lo=lsl(lo, numBits), ~hi=lor(\">>>~"(lo, 32 - numBits), lsl(hi, numBits))) + } + +let lsr_ = ({lo, hi} as x, numBits) => + if numBits == 0 { + x + } else { + let offset = numBits - 32 + if offset == 0 { + mk(~lo=hi, ~hi=0) + } else if offset > 0 { + mk(~lo=\">>>~"(hi, offset), ~hi=0) + } else { + mk(~hi=\">>>~"(hi, numBits), ~lo=lor(lsl(hi, -offset), \">>>~"(lo, numBits))) + } + } + +let asr_ = ({lo, hi} as x, numBits) => + if numBits == 0 { + x + } else if numBits < 32 { + mk( + ~hi=asr(hi, numBits), + ~lo=/* zero filled */ + lor(lsl(hi, 32 - numBits), \">>>~"(lo, numBits)), + ) + } else { + mk( + ~hi=if hi >= 0 { + 0 + } else { + -1 + }, + ~lo=asr(hi, numBits - 32), + ) + } + +let is_zero = x => + switch x { + | {lo: 0, hi: 0} => true + | _ => false + } + +let rec mul = (this, other) => + switch (this, other) { + | ({lo: 0, hi: 0}, _) + | (_, {lo: 0, hi: 0}) => zero + | ({lo: 0, hi: -0x80000000}, {lo, _}) + | ({lo, _}, {lo: 0, hi: -0x80000000}) => + if land(lo, 0x1) == 0 { + zero + } else { + min_int + } + | ({lo: this_lo, hi: this_hi}, {lo: other_lo, hi: other_hi}) => + if this_hi < 0 { + if other_hi < 0 { + mul(neg(this), neg(other)) + } else { + neg(mul(neg(this), other)) + } + } else if other_hi < 0 { + neg(mul(this, neg(other))) + } else { + /* TODO: when both are small, use float multiplication */ + let a48 = \">>>~"(this_hi, 16) + let a32 = land(this_hi, 0xffff) + let a16 = \">>>~"(this_lo, 16) + let a00 = land(this_lo, 0xffff) + + let b48 = \">>>~"(other_hi, 16) + let b32 = land(other_hi, 0xffff) + let b16 = \">>>~"(other_lo, 16) + let b00 = land(other_lo, 0xffff) + + let c48 = ref(0) + let c32 = ref(0) + let c16 = ref(0) + + let c00 = \"*~"(a00, b00) + c16.contents = \"+~"(\">>>~"(c00, 16), \"*~"(a16, b00)) + c32.contents = \">>>~"(c16.contents, 16) + c16.contents = \"+~"(land(c16.contents, 0xffff), \"*~"(a00, b16)) + c32.contents = \"+~"(\"+~"(c32.contents, \">>>~"(c16.contents, 16)), \"*~"(a32, b00)) + c48.contents = \">>>~"(c32.contents, 16) + c32.contents = \"+~"(land(c32.contents, 0xffff), \"*~"(a16, b16)) + c48.contents = \"+~"(c48.contents, \">>>~"(c32.contents, 16)) + c32.contents = \"+~"(land(c32.contents, 0xffff), \"*~"(a00, b32)) + c48.contents = \"+~"(c48.contents, \">>>~"(c32.contents, 16)) + c32.contents = land(c32.contents, 0xffff) + c48.contents = land( + \"+~"( + c48.contents, + \"+~"(\"+~"(\"+~"(\"*~"(a48, b00), \"*~"(a32, b16)), \"*~"(a16, b32)), \"*~"(a00, b48)), + ), + 0xffff, + ) + mk( + ~lo=lor(land(c00, 0xffff), lsl(land(c16.contents, 0xffff), 16)), + ~hi=lor(c32.contents, lsl(c48.contents, 16)), + ) + } + } + +/* Dispatched by the compiler, idea: should we do maximum sharing + */ +let xor = ({lo: this_lo, hi: this_hi}, {lo: other_lo, hi: other_hi}) => + mk(~lo=lxor(this_lo, other_lo), ~hi=lxor(this_hi, other_hi)) + +let or_ = ({lo: this_lo, hi: this_hi}, {lo: other_lo, hi: other_hi}) => + mk(~lo=lor(this_lo, other_lo), ~hi=lor(this_hi, other_hi)) + +let and_ = ({lo: this_lo, hi: this_hi}, {lo: other_lo, hi: other_hi}) => + mk(~lo=land(this_lo, other_lo), ~hi=land(this_hi, other_hi)) + +/* TODO: if we encode lo int32 bit as unsigned then + this is not necessary, + however (x>>>0 >>>0) is not that bad +*/ + +let to_float = ({hi, lo}: t) => + Caml_nativeint_extern.to_float(\"+~"(\"*~"(hi, %raw(`0x100000000`)), lo)) + +/** sign: Positive + -FIXME: hex notation +*/ +let two_ptr_32_dbl = 4294967296. /* 2. ** 32 */ +let two_ptr_63_dbl = 9.22337203685477581e+18 /* 2. ** 63. */ +let neg_two_ptr_63 = -9.22337203685477581e+18 /* -. (2. ** 63.) */ + +external mod_float: (float, float) => float = "?fmod_float" +/* note that we make sure the const number can acutally be represented + {[ + (2. ** 63. -. 1. = 2. ** 63.) ;; + ]} +*/ + +let rec of_float = (x: float): t => + if Caml_float_extern.isNaN(x) || Pervasives.not(Caml_float_extern.isFinite(x)) { + zero + } else if x <= neg_two_ptr_63 { + min_int + } else if x +. 1. >= two_ptr_63_dbl { + max_int /* Undefined behavior */ + } else if x < 0. { + neg(of_float(-.x)) + } else { + mk( + ~lo=Caml_nativeint_extern.of_float(mod_float(x, two_ptr_32_dbl)), + ~hi=Caml_nativeint_extern.of_float(x /. two_ptr_32_dbl), + ) + } + +@val @scope("Math") external log2: float = "LN2" +@val @scope("Math") external log: float => float = "log" +@val @scope("Math") external ceil: float => float = "ceil" +@val @scope("Math") external floor: float => float = "floor" +/* external maxFloat : float -> float -> float = "Math.max" [@@bs.val] */ + +/* either top 11 bits are all 0 or all 1 + when it is all 1, we need exclude -2^53 +*/ +let isSafeInteger = ({hi, lo}) => { + let top11Bits = asr(hi, 21) + top11Bits == 0 || (top11Bits == -1 && Pervasives.not(lo == 0 && hi == 0xff_e0_00_00)) +} + +@val external string_of_float: float => string = "String" +let rec to_string = (self: int64) => { + let {hi: self_hi, _} as self = unsafe_of_int64(self) + if isSafeInteger(self) { + string_of_float(to_float(self)) + } else if self_hi < 0 { + if eq(self, min_int) { + "-9223372036854775808" + } else { + "-" ++ to_string(unsafe_to_int64(neg(self))) + } + } else { + /* large positive number */ + let {lo, hi} as approx_div1 = of_float(floor(to_float(self) /. 10.)) + let {lo: rem_lo, hi: rem_hi} = + /* rem should be a pretty small number */ + self + ->sub_aux(~lo=lsl(lo, 3), ~hi=lor(\">>>~"(lo, 29), lsl(hi, 3))) + ->sub_aux(~lo=lsl(lo, 1), ~hi=lor(\">>>~"(lo, 31), lsl(hi, 1))) + + if rem_lo == 0 && rem_hi == 0 { + to_string(unsafe_to_int64(approx_div1)) ++ "0" + } else if rem_hi < 0 { + /* let ( {lo = rem_lo}) = neg rem in */ + let rem_lo = \">>>~"(\"+~"(lognot(rem_lo), 1), 0)->Caml_nativeint_extern.to_float + let delta = ceil(rem_lo /. 10.) + let remainder = 10. *. delta -. rem_lo + approx_div1 + ->sub_aux(~lo=Caml_nativeint_extern.of_float(delta), ~hi=0) + ->unsafe_to_int64 + ->to_string ++ Caml_nativeint_extern.to_string(Caml_nativeint_extern.of_float(remainder)) + } else { + let rem_lo = Caml_nativeint_extern.to_float(rem_lo) + let delta = floor(rem_lo /. 10.) + let remainder = rem_lo -. 10. *. delta + approx_div1 + ->add_aux(~y_lo=Caml_nativeint_extern.of_float(delta), ~y_hi=0) + ->unsafe_to_int64 + ->to_string ++ Caml_nativeint_extern.to_string(Caml_nativeint_extern.of_float(remainder)) + } + } +} + +@inline +let float_max = (a: float, b) => + if a > b { + a + } else { + b + } +let rec div = (self, other) => + switch (self, other) { + | (_, {lo: 0, hi: 0}) => raise(Division_by_zero) + | ({lo: 0, hi: 0}, _) => zero + | ({lo: 0, hi: -0x8000_0000}, _) => + if eq(other, one) || eq(other, neg_one) { + self + } else if eq(other, min_int) { + one + } else { + let {hi: other_hi, _} = other + /* now |other| >= 2, so |this/other| < |MIN_VALUE| */ + let half_this = asr_(self, 1) + let approx = lsl_(div(half_this, other), 1) + switch approx { + | {lo: 0, hi: 0} => + if other_hi < 0 { + one + } else { + neg(one) + } + | _ => + let rem = sub(self, mul(other, approx)) + add(approx, div(rem, other)) + } + } + | (_, {lo: 0, hi: -0x8000_0000}) => zero + | ({lo: _, hi: self_hi}, {lo: _, hi: other_hi}) => + if self_hi < 0 { + if other_hi < 0 { + div(neg(self), neg(other)) + } else { + neg(div(neg(self), other)) + } + } else if other_hi < 0 { + neg(div(self, neg(other))) + } else { + let res = ref(zero) + let rem = ref(self) + /* assert false */ + while ge(rem.contents, other) { + let approx = ref(float_max(1., Caml_float.floor(to_float(rem.contents) /. to_float(other)))) + let log2 = ceil(log(approx.contents) /. log2) + let delta = if log2 <= 48. { + 1. + } else { + 2. ** (log2 -. 48.) + } + let approxRes = ref(of_float(approx.contents)) + let approxRem = ref(mul(approxRes.contents, other)) + while ( + switch approxRem.contents { + | {hi, _} => hi + } < 0 || gt(approxRem.contents, rem.contents) + ) { + approx.contents = approx.contents -. delta + approxRes.contents = of_float(approx.contents) + approxRem.contents = mul(approxRes.contents, other) + } + if is_zero(approxRes.contents) { + approxRes.contents = one + } + res.contents = add(res.contents, approxRes.contents) + rem.contents = sub(rem.contents, approxRem.contents) + } + res.contents + } + } + +let mod_ = (self, other) => sub(self, mul(div(self, other), other)) + +let div_mod = (self: int64, other: int64): (int64, int64) => { + let quotient = div(unsafe_of_int64(self), unsafe_of_int64(other)) + ( + unsafe_to_int64(quotient), + unsafe_to_int64(sub(unsafe_of_int64(self), mul(quotient, unsafe_of_int64(other)))), + ) +} + +/** Note this function is unasfe here, but when combined it is actually safe + In theory, we need do an uint_compare for [lo] components + The thing is [uint_compare] and [int_compare] are specialised + to the same code when translted into js +*/ +@inline +let int_compare = (x: int, y) => + if x < y { + -1 + } else if x == y { + 0 + } else { + 1 + } + +let compare = (self, other) => { + let v = int_compare(self.hi, other.hi) + if v == 0 { + int_compare(self.lo, other.lo) + } else { + v + } +} + +let of_int32 = (lo: int) => + mk( + ~lo, + ~hi=if lo < 0 { + -1 + } else { + 0 + }, + ) + +let to_int32 = x => lor(x.lo, 0) /* signed integer */ + +/* width does matter, will it be relevant to endian order? */ + +let to_hex = (x: int64) => { + let {hi: x_hi, lo: x_lo} = unsafe_of_int64(x) + let aux = (v): string => + Caml_string_extern.of_int(Caml_nativeint_extern.shift_right_logical(v, 0), ~base=16) + + switch (x_hi, x_lo) { + | (0, 0) => "0" + | (_, 0) => aux(x_hi) ++ "00000000" + | (0, _) => aux(x_lo) + | (_, _) => + let lo = aux(x_lo) + let pad = 8 - Caml_string_extern.length(lo) + if pad <= 0 { + aux(x_hi) ++ lo + } else { + aux(x_hi) ++ (Caml_string_extern.repeat("0", pad) ++ lo) + } + } +} + +let discard_sign = (x: int64): int64 => { + let v = unsafe_of_int64(x) + unsafe_to_int64( + switch v { + | v => {...v, hi: land(0x7fff_ffff, v.hi)} + }, + ) +} + +/* >>> 0 does not change its bit representation + it simply makes sure it is an unsigned integer + -1 >>> 0 -> 4294967295 + Which is still (-1) if you interpret it as a signed integer + When we do the call (new Int32Array(x[1], x[0]), it will + convert x[0] from an unsigned integer to signed integer + {[ + new Int32Array([-1 >>> 0]) + Int32Array(1)[-1] + ]} +*/ + +let float_of_bits = (x: t): float => + ( + %raw(`function(lo,hi){ return (new Float64Array(new Int32Array([lo,hi]).buffer))[0]}`): ( + _, + _, + ) => _ + )(x.lo, x.hi) + +/* let to_int32 (x : nativeint) = x |> Caml_nativeint_extern.to_int32 + in + (*TODO: + This should get inlined, we should apply a simple inliner in the js layer, + the thing is its lambda representation is complex but after js layer, + it's qutie simple + *) + let int32 = Int32_array.make [| to_int32 x.lo; to_int32 x.hi |] in + Float64_array.unsafe_get (Float64_array.fromBuffer (Int32_array.buffer int32)) 0 */ + +let bits_of_float: float => t = x => { + let (lo, hi) = (%raw(`function(x){return new Int32Array(new Float64Array([x]).buffer)}`): _ => _)( + x, + ) + mk(~lo, ~hi) +} diff --git a/jscomp/runtime/caml.mli b/jscomp/runtime/caml_int64.resi similarity index 51% rename from jscomp/runtime/caml.mli rename to jscomp/runtime/caml_int64.resi index 658e35e7fd..63f054a175 100644 --- a/jscomp/runtime/caml.mli +++ b/jscomp/runtime/caml_int64.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,49 +17,57 @@ * 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. *) - - - - - - - -type 'a selector = 'a -> 'a -> 'a - - - - -val int_compare : int -> int -> int -val bool_compare : bool -> bool -> int -val float_compare : float -> float -> int -val string_compare : string -> string -> int - - - -val bool_min : bool selector -val int_min : int selector -val float_min : float selector -val string_min : string selector - - - -val bool_max : bool selector -val int_max : int selector -val float_max : float selector -val string_max : string selector - - - -val i64_eq : Caml_int64_extern.t -> Caml_int64_extern.t -> bool -val i64_neq : Caml_int64_extern.t -> Caml_int64_extern.t -> bool -val i64_lt : Caml_int64_extern.t -> Caml_int64_extern.t -> bool -val i64_gt : Caml_int64_extern.t -> Caml_int64_extern.t -> bool -val i64_le : Caml_int64_extern.t -> Caml_int64_extern.t -> bool -val i64_ge : Caml_int64_extern.t -> Caml_int64_extern.t -> bool - -val i64_min : Caml_int64_extern.t -> Caml_int64_extern.t -> Caml_int64_extern.t -val i64_max : Caml_int64_extern.t -> Caml_int64_extern.t -> Caml_int64_extern.t \ No newline at end of file + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +type t +let mk: (~lo: int, ~hi: int) => t +let succ: t => t +let min_int: t +let max_int: t +let one: t +let zero: t +let neg_one: t +/* val not : t -> t */ +let of_int32: int => t +let to_int32: t => int + +let add: (t, t) => t +let neg: t => t +let sub: (t, t) => t +let lsl_: (t, int) => t +let lsr_: (t, int) => t +let asr_: (t, int) => t +let is_zero: t => bool +let mul: (t, t) => t +let xor: (t, t) => t +let or_: (t, t) => t +let and_: (t, t) => t + +let equal: (t, t) => bool +let equal_null: (t, Js.null) => bool +let equal_undefined: (t, Js.undefined) => bool +let equal_nullable: (t, Js.nullable) => bool + +let to_float: t => float +let of_float: float => t +let div: (t, t) => t +let mod_: (t, t) => t + +let compare: (t, t) => int + +let float_of_bits: t => float + +/** [bits_of_float fl] it is undefined behaivor when [f] is NaN*/ +let bits_of_float: float => t + +/* val get64 : string -> int -> t */ + +external unsafe_to_int64: t => int64 = "%identity" +external unsafe_of_int64: int64 => t = "%identity" +let div_mod: (int64, int64) => (int64, int64) +let to_hex: int64 => string +let discard_sign: int64 => int64 +let to_string: int64 => string diff --git a/jscomp/runtime/caml_int64_extern.ml b/jscomp/runtime/caml_int64_extern.ml deleted file mode 100644 index 0fb59c4d80..0000000000 --- a/jscomp/runtime/caml_int64_extern.ml +++ /dev/null @@ -1,12 +0,0 @@ - - -external of_int : int -> int64 = "%int64_of_int" -external add : int64 -> int64 -> int64 = "%int64_add" -external sub : int64 -> int64 -> int64 = "%int64_sub" -external mul : int64 -> int64 -> int64 = "%int64_mul" -external div : int64 -> int64 -> int64 = "%int64_div" -external logor : int64 -> int64 -> int64 = "%int64_or" -external neg : int64 -> int64 = "%int64_neg" -external to_int : int64 -> int = "%int64_to_int" - -type t = { hi : int ; [@as "0"] lo : int ; [@as "1" ] } \ No newline at end of file diff --git a/jscomp/runtime/caml_int64_extern.res b/jscomp/runtime/caml_int64_extern.res new file mode 100644 index 0000000000..0dbe54e868 --- /dev/null +++ b/jscomp/runtime/caml_int64_extern.res @@ -0,0 +1,10 @@ +external of_int: int => int64 = "%int64_of_int" +external add: (int64, int64) => int64 = "%int64_add" +external sub: (int64, int64) => int64 = "%int64_sub" +external mul: (int64, int64) => int64 = "%int64_mul" +external div: (int64, int64) => int64 = "%int64_div" +external logor: (int64, int64) => int64 = "%int64_or" +external neg: int64 => int64 = "%int64_neg" +external to_int: int64 => int = "%int64_to_int" + +type t = {@as("0") hi: int, @as("1") lo: int} diff --git a/jscomp/runtime/caml_js_exceptions.ml b/jscomp/runtime/caml_js_exceptions.res similarity index 81% rename from jscomp/runtime/caml_js_exceptions.ml rename to jscomp/runtime/caml_js_exceptions.res index cd13b934f3..ddf35cc1c9 100644 --- a/jscomp/runtime/caml_js_exceptions.ml +++ b/jscomp/runtime/caml_js_exceptions.res @@ -1,4 +1,4 @@ -(* Copyright (C) 2015- Hongbo Zhang, Authors of ReScript +/* Copyright (C) 2015- 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 @@ -20,24 +20,23 @@ * * 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. *) - - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ exception Error = JsError - -(** +/** This function has to be in this module Since [Error] is defined here -*) -let internalToOCamlException (e : unknown) = - if Caml_exceptions.is_extension e then - (Obj.magic e : exn) - else JsError ( e) +*/ +let internalToOCamlException = (e: unknown) => + if Caml_exceptions.is_extension(e) { + (Obj.magic(e): exn) + } else { + JsError(e) + } -let as_js_exn exn = - match exn with - | Error t -> - Some t - | _ -> None \ No newline at end of file +let as_js_exn = exn => + switch exn { + | Error(t) => Some(t) + | _ => None + } diff --git a/jscomp/runtime/caml_lexer.ml b/jscomp/runtime/caml_lexer.res similarity index 93% rename from jscomp/runtime/caml_lexer.ml rename to jscomp/runtime/caml_lexer.res index b6115f3a4c..69f228b58e 100644 --- a/jscomp/runtime/caml_lexer.ml +++ b/jscomp/runtime/caml_lexer.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,24 +17,20 @@ * 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. *) - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -type lex_tables +type lex_tables type lexbuf -(** *) +/* caml_lex_array("abcd") */ +/* [25185, 25699] */ +/* @param s */ +/* @returns {any[]} */ -(* caml_lex_array("abcd") *) -(* [25185, 25699] *) -(* @param s *) -(* @returns {any[]} *) - - -[%%bs.raw{| +%%raw(` /***********************************************************************/ /* */ @@ -64,9 +60,9 @@ function caml_lex_array(s) { a[i] = (s.charCodeAt(2 * i) | (s.charCodeAt(2 * i + 1) << 8)) << 16 >> 16; return a; } -|}] +`) -(** +/* * external c_engine : lex_tables -> int -> lexbuf -> int * lexing.ml * type lex_tables = { @@ -101,8 +97,14 @@ function caml_lex_array(s) { * @param start_state * @param lexbuf * @returns {any} - *) -let caml_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int = [%raw{|function (tbl, start_state, lexbuf, exn){ + */ + +let caml_lex_engine_aux: ( + lex_tables, + int, + lexbuf, + exn, +) => int = %raw(`function (tbl, start_state, lexbuf, exn){ if (!Array.isArray(tbl.lex_default)) { tbl.lex_base = caml_lex_array(tbl.lex_base); @@ -171,15 +173,14 @@ let caml_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int = [%raw{|fun } } } -|}] +`) let empty_token_lit = "lexing: empty token" -let lex_engine : lex_tables -> int -> lexbuf -> int = - fun tbls i buf -> - caml_lex_engine_aux tbls i buf (Failure empty_token_lit) +let lex_engine: (lex_tables, int, lexbuf) => int = (tbls, i, buf) => + caml_lex_engine_aux(tbls, i, buf, Failure(empty_token_lit)) -[%%bs.raw{| +%%raw(` /***********************************************/ @@ -226,18 +227,22 @@ function caml_lex_run_tag(s, i, mem) { mem[dst] = mem[src]; } } -|}] +`) -(** +/* * external c_new_engine : lex_tables -> int -> lexbuf -> int = "?new_lex_engine" * @param tbl * @param start_state * @param lexbuf * @returns {any} - *) - + */ -let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int= [%raw{|function (tbl, start_state, lexbuf, exn) { +let caml_new_lex_engine_aux: ( + lex_tables, + int, + lexbuf, + exn, +) => int = %raw(`function (tbl, start_state, lexbuf, exn) { if (!Array.isArray(tbl.lex_default)) { tbl.lex_base = caml_lex_array(tbl.lex_base); @@ -324,11 +329,7 @@ let caml_new_lex_engine_aux : lex_tables -> int -> lexbuf -> exn -> int= [%raw{| } } } -|}] - - - -let new_lex_engine : lex_tables -> int -> lexbuf -> int - = fun tbl i buf -> -caml_new_lex_engine_aux tbl i buf (Failure empty_token_lit) +`) +let new_lex_engine: (lex_tables, int, lexbuf) => int = (tbl, i, buf) => + caml_new_lex_engine_aux(tbl, i, buf, Failure(empty_token_lit)) diff --git a/jscomp/runtime/caml_lexer.resi b/jscomp/runtime/caml_lexer.resi new file mode 100644 index 0000000000..cd01e892f1 --- /dev/null +++ b/jscomp/runtime/caml_lexer.resi @@ -0,0 +1,31 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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. */ + +/* the same as Lexing */ +type lex_tables +type lexbuf + +let lex_engine: (lex_tables, int, lexbuf) => int + +let new_lex_engine: (lex_tables, int, lexbuf) => int diff --git a/jscomp/runtime/caml_md5.ml b/jscomp/runtime/caml_md5.ml deleted file mode 100644 index 3f90203fde..0000000000 --- a/jscomp/runtime/caml_md5.ml +++ /dev/null @@ -1,220 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - -let lognot n = n lxor (-1l) -let cmn q a b x s t = - let a = a + q + x + t in - ((a lsl s) lor (a lsr (32 - s))) + b - - -let f a b c d x s t = - cmn ((b land c) lor (lognot b land d)) a b x s t - - -let g a b c d x s t = - cmn ((b land d) lor (c land (lognot d))) a b x s t - -;; -let h a b c d x s t = - cmn (b lxor c lxor d) a b x s t -;; - -let i a b c d x s t = - cmn (c lxor (b lor (lognot d))) a b x s t - -let {unsafe_get = (.!()) - ; unsafe_set = (.!()<-) - } = (module Caml_array_extern) -let cycle (x : int array) (k : int array) = - let a = ref x.!(0) in - let b = ref x.!(1) in - let c = ref x.!(2) in - let d = ref x.!(3) in - - a .contents<- f a.contents b.contents c.contents d.contents k.!(0) 7 0xd76aa478l; - d .contents<- f d.contents a.contents b.contents c.contents k.!(1) 12 0xe8c7b756l; - c .contents<- f c.contents d.contents a.contents b.contents k.!(2) 17 0x242070dbl; - b .contents<- f b.contents c.contents d.contents a.contents k.!(3) 22 0xc1bdceeel; - - a .contents<- f a.contents b.contents c.contents d.contents k.!(4) 7 0xf57c0fafl; - d .contents<- f d.contents a.contents b.contents c.contents k.!(5) 12 0x4787c62al; - c .contents<- f c.contents d.contents a.contents b.contents k.!(6) 17 0xa8304613l; - b .contents<- f b.contents c.contents d.contents a.contents k.!(7) 22 0xfd469501l; - - a .contents<- f a.contents b.contents c.contents d.contents k.!(8) 7 0x698098d8l; - d .contents<- f d.contents a.contents b.contents c.contents k.!(9) 12 0x8b44f7afl; - c .contents<- f c.contents d.contents a.contents b.contents k.!(10) 17 0xffff5bb1l; - b .contents<- f b.contents c.contents d.contents a.contents k.!(11) 22 0x895cd7bel; - a .contents<- f a.contents b.contents c.contents d.contents k.!(12) 7 0x6b901122l; - d .contents<- f d.contents a.contents b.contents c.contents k.!(13) 12 0xfd987193l; - c .contents<- f c.contents d.contents a.contents b.contents k.!(14) 17 0xa679438el; - b .contents<- f b.contents c.contents d.contents a.contents k.!(15) 22 0x49b40821l; - - a .contents<- g a.contents b.contents c.contents d.contents k.!(1) 5 0xf61e2562l; - d .contents<- g d.contents a.contents b.contents c.contents k.!(6) 9 0xc040b340l; - c .contents<- g c.contents d.contents a.contents b.contents k.!(11) 14 0x265e5a51l; - b .contents<- g b.contents c.contents d.contents a.contents k.!(0) 20 0xe9b6c7aal; - a .contents<- g a.contents b.contents c.contents d.contents k.!(5) 5 0xd62f105dl; - d .contents<- g d.contents a.contents b.contents c.contents k.!(10) 9 0x2441453l; - c .contents<- g c.contents d.contents a.contents b.contents k.!(15) 14 0xd8a1e681l; - b .contents<- g b.contents c.contents d.contents a.contents k.!(4) 20 0xe7d3fbc8l; - a .contents<- g a.contents b.contents c.contents d.contents k.!(9) 5 0x21e1cde6l; - d .contents<- g d.contents a.contents b.contents c.contents k.!(14) 9 0xc33707d6l; - c .contents<- g c.contents d.contents a.contents b.contents k.!(3) 14 0xf4d50d87l; - b .contents<- g b.contents c.contents d.contents a.contents k.!(8) 20 0x455a14edl; - a .contents<- g a.contents b.contents c.contents d.contents k.!(13) 5 0xa9e3e905l; - d .contents<- g d.contents a.contents b.contents c.contents k.!(2) 9 0xfcefa3f8l; - c .contents<- g c.contents d.contents a.contents b.contents k.!(7) 14 0x676f02d9l; - b .contents<- g b.contents c.contents d.contents a.contents k.!(12) 20 0x8d2a4c8al; - - a .contents<- h a.contents b.contents c.contents d.contents k.!(5) 4 0xfffa3942l; - d .contents<- h d.contents a.contents b.contents c.contents k.!(8) 11 0x8771f681l; - c .contents<- h c.contents d.contents a.contents b.contents k.!(11) 16 0x6d9d6122l; - b .contents<- h b.contents c.contents d.contents a.contents k.!(14) 23 0xfde5380cl; - a .contents<- h a.contents b.contents c.contents d.contents k.!(1) 4 0xa4beea44l; - d .contents<- h d.contents a.contents b.contents c.contents k.!(4) 11 0x4bdecfa9l; - c .contents<- h c.contents d.contents a.contents b.contents k.!(7) 16 0xf6bb4b60l; - b .contents<- h b.contents c.contents d.contents a.contents k.!(10) 23 0xbebfbc70l; - a .contents<- h a.contents b.contents c.contents d.contents k.!(13) 4 0x289b7ec6l; - d .contents<- h d.contents a.contents b.contents c.contents k.!(0) 11 0xeaa127fal; - c .contents<- h c.contents d.contents a.contents b.contents k.!(3) 16 0xd4ef3085l; - b .contents<- h b.contents c.contents d.contents a.contents k.!(6) 23 0x4881d05l; - a .contents<- h a.contents b.contents c.contents d.contents k.!(9) 4 0xd9d4d039l; - d .contents<- h d.contents a.contents b.contents c.contents k.!(12) 11 0xe6db99e5l; - c .contents<- h c.contents d.contents a.contents b.contents k.!(15) 16 0x1fa27cf8l; - b .contents<- h b.contents c.contents d.contents a.contents k.!(2) 23 0xc4ac5665l; - - a .contents<- i a.contents b.contents c.contents d.contents k.!(0) 6 0xf4292244l; - d .contents<- i d.contents a.contents b.contents c.contents k.!(7) 10 0x432aff97l; - c .contents<- i c.contents d.contents a.contents b.contents k.!(14) 15 0xab9423a7l; - b .contents<- i b.contents c.contents d.contents a.contents k.!(5) 21 0xfc93a039l; - a .contents<- i a.contents b.contents c.contents d.contents k.!(12) 6 0x655b59c3l; - d .contents<- i d.contents a.contents b.contents c.contents k.!(3) 10 0x8f0ccc92l; - c .contents<- i c.contents d.contents a.contents b.contents k.!(10) 15 0xffeff47dl; - b .contents<- i b.contents c.contents d.contents a.contents k.!(1) 21 0x85845dd1l; - a .contents<- i a.contents b.contents c.contents d.contents k.!(8) 6 0x6fa87e4fl; - d .contents<- i d.contents a.contents b.contents c.contents k.!(15) 10 0xfe2ce6e0l; - c .contents<- i c.contents d.contents a.contents b.contents k.!(6) 15 0xa3014314l; - b .contents<- i b.contents c.contents d.contents a.contents k.!(13) 21 0x4e0811a1l; - a .contents<- i a.contents b.contents c.contents d.contents k.!(4) 6 0xf7537e82l; - d .contents<- i d.contents a.contents b.contents c.contents k.!(11) 10 0xbd3af235l; - c .contents<- i c.contents d.contents a.contents b.contents k.!(2) 15 0x2ad7d2bbl; - b .contents<- i b.contents c.contents d.contents a.contents k.!(9) 21 0xeb86d391l; - - x.!(0) <- a.contents + x.!(0); - x.!(1) <- b.contents + x.!(1); - x.!(2) <- c.contents + x.!(2); - x.!(3) <- d.contents + x.!(3) - - -let seed_a = 0x67452301l -let seed_b = 0xefcdab89l -let seed_c = 0x98badcfel -let seed_d = 0x10325476l - -let state = [| seed_a; seed_b ; seed_c; seed_d |] - -let md5blk = [| - 0l;0l;0l;0l; - 0l;0l;0l;0l; - 0l;0l;0l;0l; - 0l;0l;0l;0l -|] -external (.![]) : string -> int -> int = "charCodeAt" [@@bs.send] - -let md5_string (s : string) (start:int) (len:int) : string = - let s = Caml_string_extern.slice s start len in - let n =Caml_string_extern.length s in - let () = - state.!(0) <- seed_a; - state.!(1) <- seed_b; - state.!(2) <- seed_c; - state.!(3) <- seed_d ; - for i = 0 to 15 do - md5blk.!(i) <- 0l - done - in - - - let i_end = n / 64 in - for i = 1 to i_end do - for j = 0 to 16 - 1 do - let k = i * 64 - 64 + j * 4 in - md5blk.!(j) <- s.![k] + - (s.![k+1] lsl 8 ) + - (s.![k+2] lsl 16 ) + - (s.![k+3] lsl 24 ) - done ; - cycle state md5blk - done ; - - let s_tail = Caml_string_extern.slice_rest s (i_end * 64) in - for kk = 0 to 15 do - md5blk.!(kk) <- 0l - done ; - let i_end =Caml_string_extern.length s_tail - 1 in - for i = 0 to i_end do - md5blk.!(i / 4 ) <- - md5blk.!(i / 4) lor ( s_tail.![i] lsl ((i mod 4) lsl 3)) - done ; - let i = i_end + 1 in - md5blk.!(i / 4 ) <- md5blk.!(i / 4 ) lor (0x80l lsl ((i mod 4) lsl 3)) ; - if i > 55 then - begin - cycle state md5blk; - for i = 0 to 15 do - md5blk.!(i) <- 0 - done - end; - md5blk.!(14) <- n * 8; - cycle state md5blk; - Caml_string_extern.of_small_int32_array [| - state.!(0) land 0xff; - (state.!(0) asr 8) land 0xff; - (state.!(0) asr 16) land 0xff; - (state.!(0) asr 24) land 0xff; - - state.!(1) land 0xff; - (state.!(1) asr 8) land 0xff; - (state.!(1) asr 16) land 0xff; - (state.!(1) asr 24) land 0xff; - - state.!(2) land 0xff; - (state.!(2) asr 8) land 0xff; - (state.!(2) asr 16) land 0xff; - (state.!(2) asr 24) land 0xff; - - state.!(3) land 0xff; - (state.!(3) asr 8) land 0xff; - (state.!(3) asr 16) land 0xff; - (state.!(3) asr 24) land 0xff; - - |] - - - - - - diff --git a/jscomp/runtime/caml_md5.res b/jscomp/runtime/caml_md5.res new file mode 100644 index 0000000000..b6b22d6205 --- /dev/null +++ b/jscomp/runtime/caml_md5.res @@ -0,0 +1,201 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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. */ + +let lognot = n => lxor(n, -1l) +let cmn = (q, a, b, x, s, t) => { + let a = a + q + x + t + lor(lsl(a, s), lsr(a, 32 - s)) + b +} + +let f = (a, b, c, d, x, s, t) => cmn(lor(land(b, c), land(lognot(b), d)), a, b, x, s, t) + +let g = (a, b, c, d, x, s, t) => cmn(lor(land(b, d), land(c, lognot(d))), a, b, x, s, t) + +let h = (a, b, c, d, x, s, t) => cmn(lxor(lxor(b, c), d), a, b, x, s, t) + +let i = (a, b, c, d, x, s, t) => cmn(lxor(c, lor(b, lognot(d))), a, b, x, s, t) + +let {unsafe_get, unsafe_set} = module(Caml_array_extern) + +let cycle = (x: array, k: array) => { + let a = ref(x->unsafe_get(0)) + let b = ref(x->unsafe_get(1)) + let c = ref(x->unsafe_get(2)) + let d = ref(x->unsafe_get(3)) + + a.contents = f(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(0), 7, 0xd76aa478l) + d.contents = f(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(1), 12, 0xe8c7b756l) + c.contents = f(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(2), 17, 0x242070dbl) + b.contents = f(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(3), 22, 0xc1bdceeel) + + a.contents = f(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(4), 7, 0xf57c0fafl) + d.contents = f(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(5), 12, 0x4787c62al) + c.contents = f(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(6), 17, 0xa8304613l) + b.contents = f(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(7), 22, 0xfd469501l) + + a.contents = f(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(8), 7, 0x698098d8l) + d.contents = f(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(9), 12, 0x8b44f7afl) + c.contents = f(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(10), 17, 0xffff5bb1l) + b.contents = f(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(11), 22, 0x895cd7bel) + a.contents = f(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(12), 7, 0x6b901122l) + d.contents = f(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(13), 12, 0xfd987193l) + c.contents = f(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(14), 17, 0xa679438el) + b.contents = f(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(15), 22, 0x49b40821l) + + a.contents = g(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(1), 5, 0xf61e2562l) + d.contents = g(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(6), 9, 0xc040b340l) + c.contents = g(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(11), 14, 0x265e5a51l) + b.contents = g(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(0), 20, 0xe9b6c7aal) + a.contents = g(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(5), 5, 0xd62f105dl) + d.contents = g(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(10), 9, 0x2441453l) + c.contents = g(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(15), 14, 0xd8a1e681l) + b.contents = g(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(4), 20, 0xe7d3fbc8l) + a.contents = g(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(9), 5, 0x21e1cde6l) + d.contents = g(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(14), 9, 0xc33707d6l) + c.contents = g(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(3), 14, 0xf4d50d87l) + b.contents = g(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(8), 20, 0x455a14edl) + a.contents = g(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(13), 5, 0xa9e3e905l) + d.contents = g(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(2), 9, 0xfcefa3f8l) + c.contents = g(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(7), 14, 0x676f02d9l) + b.contents = g(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(12), 20, 0x8d2a4c8al) + + a.contents = h(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(5), 4, 0xfffa3942l) + d.contents = h(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(8), 11, 0x8771f681l) + c.contents = h(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(11), 16, 0x6d9d6122l) + b.contents = h(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(14), 23, 0xfde5380cl) + a.contents = h(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(1), 4, 0xa4beea44l) + d.contents = h(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(4), 11, 0x4bdecfa9l) + c.contents = h(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(7), 16, 0xf6bb4b60l) + b.contents = h(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(10), 23, 0xbebfbc70l) + a.contents = h(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(13), 4, 0x289b7ec6l) + d.contents = h(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(0), 11, 0xeaa127fal) + c.contents = h(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(3), 16, 0xd4ef3085l) + b.contents = h(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(6), 23, 0x4881d05l) + a.contents = h(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(9), 4, 0xd9d4d039l) + d.contents = h(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(12), 11, 0xe6db99e5l) + c.contents = h(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(15), 16, 0x1fa27cf8l) + b.contents = h(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(2), 23, 0xc4ac5665l) + + a.contents = i(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(0), 6, 0xf4292244l) + d.contents = i(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(7), 10, 0x432aff97l) + c.contents = i(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(14), 15, 0xab9423a7l) + b.contents = i(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(5), 21, 0xfc93a039l) + a.contents = i(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(12), 6, 0x655b59c3l) + d.contents = i(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(3), 10, 0x8f0ccc92l) + c.contents = i(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(10), 15, 0xffeff47dl) + b.contents = i(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(1), 21, 0x85845dd1l) + a.contents = i(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(8), 6, 0x6fa87e4fl) + d.contents = i(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(15), 10, 0xfe2ce6e0l) + c.contents = i(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(6), 15, 0xa3014314l) + b.contents = i(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(13), 21, 0x4e0811a1l) + a.contents = i(a.contents, b.contents, c.contents, d.contents, k->unsafe_get(4), 6, 0xf7537e82l) + d.contents = i(d.contents, a.contents, b.contents, c.contents, k->unsafe_get(11), 10, 0xbd3af235l) + c.contents = i(c.contents, d.contents, a.contents, b.contents, k->unsafe_get(2), 15, 0x2ad7d2bbl) + b.contents = i(b.contents, c.contents, d.contents, a.contents, k->unsafe_get(9), 21, 0xeb86d391l) + + unsafe_set(x, 0, a.contents + x->unsafe_get(0)) + unsafe_set(x, 1, b.contents + x->unsafe_get(1)) + unsafe_set(x, 2, c.contents + x->unsafe_get(2)) + unsafe_set(x, 3, d.contents + x->unsafe_get(3)) +} + +let seed_a = 0x67452301l +let seed_b = 0xefcdab89l +let seed_c = 0x98badcfel +let seed_d = 0x10325476l + +let state = [seed_a, seed_b, seed_c, seed_d] + +let md5blk = [0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l, 0l] + +@send external charCodeAt: (string, int) => int = "charCodeAt" + +let md5_string = (s: string, start: int, len: int): string => { + let s = Caml_string_extern.slice(s, start, len) + let n = Caml_string_extern.length(s) + let () = { + state->unsafe_set(0, seed_a) + state->unsafe_set(1, seed_b) + state->unsafe_set(2, seed_c) + state->unsafe_set(3, seed_d) + for i in 0 to 15 { + md5blk->unsafe_set(i, 0l) + } + } + + let i_end = n / 64 + for i in 1 to i_end { + for j in 0 to 16 - 1 { + let k = i * 64 - 64 + j * 4 + md5blk->unsafe_set( + j, + charCodeAt(s, k) + + lsl(s->charCodeAt(k + 1), 8) + + lsl(s->charCodeAt(k + 2), 16) + + lsl(s->charCodeAt(k + 3), 24), + ) + } + cycle(state, md5blk) + } + + let s_tail = Caml_string_extern.slice_rest(s, i_end * 64) + for kk in 0 to 15 { + md5blk->unsafe_set(kk, 0l) + } + let i_end = Caml_string_extern.length(s_tail) - 1 + for i in 0 to i_end { + md5blk->unsafe_set( + i / 4, + lor(unsafe_get(md5blk, i / 4), lsl(charCodeAt(s_tail, i), lsl(mod(i, 4), 3))), + ) + } + let i = i_end + 1 + md5blk->unsafe_set(i / 4, lor(unsafe_get(md5blk, i / 4), lsl(0x80l, lsl(mod(i, 4), 3)))) + if i > 55 { + cycle(state, md5blk) + for i in 0 to 15 { + md5blk->unsafe_set(i, 0) + } + } + unsafe_set(md5blk, 14, n * 8) + cycle(state, md5blk) + Caml_string_extern.of_small_int32_array([ + land(state->unsafe_get(0), 0xff), + land(asr(state->unsafe_get(0), 8), 0xff), + land(asr(state->unsafe_get(0), 16), 0xff), + land(asr(state->unsafe_get(0), 24), 0xff), + land(state->unsafe_get(1), 0xff), + land(asr(state->unsafe_get(1), 8), 0xff), + land(asr(state->unsafe_get(1), 16), 0xff), + land(asr(state->unsafe_get(1), 24), 0xff), + land(state->unsafe_get(2), 0xff), + land(asr(state->unsafe_get(2), 8), 0xff), + land(asr(state->unsafe_get(2), 16), 0xff), + land(asr(state->unsafe_get(2), 24), 0xff), + land(state->unsafe_get(3), 0xff), + land(asr(state->unsafe_get(3), 8), 0xff), + land(asr(state->unsafe_get(3), 16), 0xff), + land(asr(state->unsafe_get(3), 24), 0xff), + ]) +} diff --git a/jscomp/runtime/caml_string.mli b/jscomp/runtime/caml_md5.resi similarity index 89% rename from jscomp/runtime/caml_string.mli rename to jscomp/runtime/caml_md5.resi index 1f8f3ac935..c7bb429ff5 100644 --- a/jscomp/runtime/caml_string.mli +++ b/jscomp/runtime/caml_md5.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,12 +17,9 @@ * 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. *) - - -val get : string -> int -> char + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -val make : int -> char -> string \ No newline at end of file +let md5_string: (string, int, int) => string diff --git a/jscomp/runtime/caml_module.ml b/jscomp/runtime/caml_module.ml deleted file mode 100644 index c5a8f30b34..0000000000 --- a/jscomp/runtime/caml_module.ml +++ /dev/null @@ -1,107 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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 replaced camlinternalMod completely. - Note we can replace {!CamlinternalMod} completely, but it is not replaced - due to we believe this is an even low level dependency -*) - -[@@@warning "-37"] (* `Function` may be used in runtime *) - -type shape = - | Function - | Lazy - | Class - | Module of (shape * string) array - | Value of Obj.t - (* ATTENTION: check across versions *) -module Array = Caml_array_extern - -external set_field : Obj.t -> string -> Obj.t -> unit = "" -[@@bs.set_index] - -external get_field : Obj.t -> string -> Obj.t = "" -[@@bs.get_index] - -module type Empty = sig end - -(** Note that we have to provide a drop in replacement, since compiler internally will - spit out ("CamlinternalMod".[init_mod|update_mod] unless we intercept it - in the lambda layer -*) -let init_mod (loc : string * int * int) (shape : shape) = - let undef_module _ = raise (Undefined_recursive_module loc) in - let rec loop (shape : shape) (struct_ : Obj.t) idx = - match shape with - | Function -> - set_field struct_ idx (Obj.magic undef_module) - | Lazy -> - set_field struct_ idx (Obj.magic (lazy undef_module)) - | Class -> - set_field struct_ idx - (Obj.magic (*ref {!CamlinternalOO.dummy_class loc} *) - (undef_module, undef_module, undef_module, 0) - (* depends on dummy class representation *) - ) - | Module comps - -> - let v = Obj.repr (module struct end : Empty) in - set_field struct_ idx v ; - let len = Array.length comps in - for i = 0 to len - 1 do - let shape, name = comps.(i) in - loop shape v name - done - | Value v -> - set_field struct_ idx v in - let res = Obj.repr (module struct end : Empty) in - let dummy_name = "dummy" in - loop shape res dummy_name; - get_field res dummy_name - -(* Note the [shape] passed between [init_mod] and [update_mod] is always the same - and we assume [module] is encoded as an array -*) -let update_mod (shape : shape) (o : Obj.t) (n : Obj.t) : unit = - let rec aux (shape : shape) o n parent i = - match shape with - | Function - -> set_field parent i n - - | Lazy - | Class -> - Caml_obj.update_dummy o n - | Module comps - -> - for i = 0 to Array.length comps - 1 do - let shape, name = comps.(i) in - aux shape (get_field o name ) (get_field n name) o name - done - | Value _ -> () in - match shape with - | Module comps -> - for i = 0 to Array.length comps - 1 do - let shape, name = comps.(i) in - aux shape (get_field o name) (get_field n name) o name - done - | _ -> assert false diff --git a/jscomp/runtime/caml_module.mli b/jscomp/runtime/caml_module.mli deleted file mode 100644 index 3205cddaa4..0000000000 --- a/jscomp/runtime/caml_module.mli +++ /dev/null @@ -1,14 +0,0 @@ - - -type shape - -val init_mod : - (string * int * int) -> - shape -> - Obj.t - -val update_mod: - shape -> - Obj.t -> - Obj.t -> - unit \ No newline at end of file diff --git a/jscomp/runtime/caml_module.res b/jscomp/runtime/caml_module.res new file mode 100644 index 0000000000..a510385349 --- /dev/null +++ b/jscomp/runtime/caml_module.res @@ -0,0 +1,111 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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 replaced camlinternalMod completely. + Note we can replace {!CamlinternalMod} completely, but it is not replaced + due to we believe this is an even low level dependency +*/ + +@@warning("-37") /* `Function` may be used in runtime */ + +type rec shape = + | Function + | Lazy + | Class + | Module(array<(shape, string)>) + | Value(Obj.t) +/* ATTENTION: check across versions */ +module Array = Caml_array_extern + +@set_index external set_field: (Obj.t, string, Obj.t) => unit = "" + +@get_index external get_field: (Obj.t, string) => Obj.t = "" + +module type Empty = {} + +/** Note that we have to provide a drop in replacement, since compiler internally will + spit out ("CamlinternalMod".[init_mod|update_mod] unless we intercept it + in the lambda layer +*/ +let init_mod = (loc: (string, int, int), shape: shape) => { + let undef_module = _ => raise(Undefined_recursive_module(loc)) + let rec loop = (shape: shape, struct_: Obj.t, idx) => + switch shape { + | Function => set_field(struct_, idx, Obj.magic(undef_module)) + | Lazy => set_field(struct_, idx, Obj.magic(lazy undef_module)) + | Class => + set_field( + struct_, + idx, + Obj.magic /* ref {!CamlinternalOO.dummy_class loc} */(( + undef_module, + undef_module, + undef_module, + 0, + )), + /* depends on dummy class representation */ + ) + | Module(comps) => + let v = Obj.repr(module({}: Empty)) + set_field(struct_, idx, v) + let len = Array.length(comps) + for i in 0 to len - 1 { + let (shape, name) = Caml_array_extern.unsafe_get(comps, i) + loop(shape, v, name) + } + | Value(v) => set_field(struct_, idx, v) + } + let res = Obj.repr(module({}: Empty)) + let dummy_name = "dummy" + loop(shape, res, dummy_name) + get_field(res, dummy_name) +} + +/* Note the [shape] passed between [init_mod] and [update_mod] is always the same + and we assume [module] is encoded as an array +*/ +let update_mod = (shape: shape, o: Obj.t, n: Obj.t): unit => { + let rec aux = (shape: shape, o, n, parent, i) => + switch shape { + | Function => set_field(parent, i, n) + + | Lazy + | Class => + Caml_obj.update_dummy(o, n) + | Module(comps) => + for i in 0 to Array.length(comps) - 1 { + let (shape, name) = Caml_array_extern.unsafe_get(comps, i) + aux(shape, get_field(o, name), get_field(n, name), o, name) + } + | Value(_) => () + } + switch shape { + | Module(comps) => + for i in 0 to Array.length(comps) - 1 { + let (shape, name) = Caml_array_extern.unsafe_get(comps, i) + aux(shape, get_field(o, name), get_field(n, name), o, name) + } + | _ => assert(false) + } +} diff --git a/jscomp/runtime/caml_module.resi b/jscomp/runtime/caml_module.resi new file mode 100644 index 0000000000..9cb284e722 --- /dev/null +++ b/jscomp/runtime/caml_module.resi @@ -0,0 +1,5 @@ +type shape + +let init_mod: ((string, int, int), shape) => Obj.t + +let update_mod: (shape, Obj.t, Obj.t) => unit diff --git a/jscomp/runtime/caml_nativeint_extern.ml b/jscomp/runtime/caml_nativeint_extern.ml deleted file mode 100644 index 455f1bbf9a..0000000000 --- a/jscomp/runtime/caml_nativeint_extern.ml +++ /dev/null @@ -1,16 +0,0 @@ - - - - - -external add : int -> int -> int = "?nativeint_add" -external div : int -> int -> int = "?nativeint_div" -external rem : int -> int -> int = "?nativeint_mod" -external shift_right_logical : int -> int -> int = "?nativeint_lsr" -external mul : int -> int -> int = "?nativeint_mul" - -external to_float : int -> float = "%identity" -external of_float : float -> int = "?int_of_float" -(* TODO: this could be promoted to `#int_of_float` *) -external to_string : int -> string = "String" [@@bs.val] - diff --git a/jscomp/runtime/caml_nativeint_extern.res b/jscomp/runtime/caml_nativeint_extern.res new file mode 100644 index 0000000000..ca19ae8622 --- /dev/null +++ b/jscomp/runtime/caml_nativeint_extern.res @@ -0,0 +1,10 @@ +external add: (int, int) => int = "?nativeint_add" +external div: (int, int) => int = "?nativeint_div" +external rem: (int, int) => int = "?nativeint_mod" +external shift_right_logical: (int, int) => int = "?nativeint_lsr" +external mul: (int, int) => int = "?nativeint_mul" + +external to_float: int => float = "%identity" +external of_float: float => int = "?int_of_float" +/* TODO: this could be promoted to `#int_of_float` */ +@val external to_string: int => string = "String" diff --git a/jscomp/runtime/caml_obj.res b/jscomp/runtime/caml_obj.res index 0064d4da2f..cd45d644d2 100644 --- a/jscomp/runtime/caml_obj.res +++ b/jscomp/runtime/caml_obj.res @@ -33,19 +33,19 @@ module O = { @scope(("Object", "prototype", "hasOwnProperty")) @val - @ocaml.doc(" + /** JS objects are not guaranteed to have `Object` in their prototype chain so calling `some_obj.hasOwnProperty(key)` can sometimes throw an exception when dealing with JS interop. This mainly occurs when objects are created via `Object.create(null)`. The only safe way to call this function is directly, e.g. `Object.prototype.hasOwnProperty.call(some_obj, key)`. - ") + */ external hasOwnProperty: (t, key) => bool = "call" @get_index external get_value: (Obj.t, key) => Obj.t = "" } -@@ocaml.text(" +/** Since now we change it back to use Array representation this function is higly dependent @@ -70,8 +70,7 @@ module O = { ]} `obj_dup` is a superset of `array_dup` -") - +*/ let obj_dup: Obj.t => Obj.t = %raw(`function(x){ if(Array.isArray(x)){ var len = x.length @@ -112,7 +111,7 @@ let update_dummy: (_, _) => unit = %raw(`function(x,y){ } `) -@ocaml.doc(" TODO: investigate total +/** TODO: investigate total [compare x y] returns [0] if [x] is equal to [y], a negative integer if [x] is less than [y], and a positive integer if [x] is greater than [y]. @@ -128,7 +127,7 @@ let update_dummy: (_, _) => unit = %raw(`function(x,y){ The compare function can be used as the comparison function required by the [Set.Make] and [Map.Make] functors, as well as the [List.sort] and [Array.sort] functions. -") +*/ let rec compare = (a: Obj.t, b: Obj.t): int => if a === b { 0 @@ -300,9 +299,9 @@ and aux_obj_compare = (a: Obj.t, b: Obj.t) => { type eq = (Obj.t, Obj.t) => bool -@ocaml.doc(" It is easier to do equality check than comparision, since as long as its +/** It is easier to do equality check than comparision, since as long as its basic type is not the same, it will not equal -") +*/ let rec equal = (a: Obj.t, b: Obj.t): bool => /* front and formoest, we do not compare function values */ if a === b { diff --git a/jscomp/runtime/caml_option.ml b/jscomp/runtime/caml_option.ml deleted file mode 100644 index 42bc49e3e9..0000000000 --- a/jscomp/runtime/caml_option.ml +++ /dev/null @@ -1,86 +0,0 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * - * 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. *) - - -type nested = { - depth : int ; [@bs.as "BS_PRIVATE_NESTED_SOME_NONE"] -} - -(* INPUT: [x] should not be nullable *) -let isNested (x : Obj.t) : bool = - Obj.repr ((Obj.magic x : nested).depth) != Obj.repr Js.undefined - -let some ( x : Obj.t) : Obj.t = - if Obj.magic x = None then - (Obj.repr {depth = 0}) - else - (* [x] is neither None nor null so it is safe to do property access *) - if x != Obj.repr Js.null && isNested x then - Obj.repr {depth = (Obj.magic x : nested).depth + 1} - else x - -let nullable_to_opt (type t) ( x : t Js.nullable) : t option = - if Js.isNullable x then - None - else Obj.magic (some (Obj.magic x : 'a)) - -let undefined_to_opt (type t) ( x : t Js.undefined) : t option = - if (Obj.magic x) == Js.undefined then None - else Obj.magic (some (Obj.magic x : 'a)) - -let null_to_opt (type t ) ( x : t Js.null) : t option = - if (Obj.magic x) == Js.null then None - else Obj.magic (some (Obj.magic x : 'a) ) - -(* external valFromOption : 'a option -> 'a = - "#val_from_option" *) - - - -(** The input is already of [Some] form, [x] is not None, - make sure [x[0]] will not throw *) -let valFromOption (x : Obj.t) : Obj.t = - if x != Obj.repr Js.null && isNested x - then - let {depth } : nested = Obj.magic x in - if depth = 0 then Obj.magic None - else Obj.repr {depth = depth - 1} - else Obj.magic x - - -let option_get (x : 'a option) = - if x = None then Caml_undefined_extern.empty - else Obj.magic (valFromOption (Obj.repr x)) - - -type poly = { - hash : int [@bs.as "HASH" (* Literals.polyvar_hash*)]; - value : Obj.t [@bs.as "VAL"] -} - -(** [input] is optional polymorphic variant *) -let option_unwrap (x : poly option) = - match x with - | None -> Obj.repr x - | Some x -> x.value diff --git a/jscomp/runtime/caml_option.res b/jscomp/runtime/caml_option.res new file mode 100644 index 0000000000..346205611f --- /dev/null +++ b/jscomp/runtime/caml_option.res @@ -0,0 +1,95 @@ +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * + * 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. */ + +type nested = {@as("BS_PRIVATE_NESTED_SOME_NONE") depth: int} + +/* INPUT: [x] should not be nullable */ +let isNested = (x: Obj.t): bool => Obj.repr((Obj.magic(x): nested).depth) !== Obj.repr(Js.undefined) + +let some = (x: Obj.t): Obj.t => + if Obj.magic(x) == None { + Obj.repr({depth: 0}) + } /* [x] is neither None nor null so it is safe to do property access */ + else if x !== Obj.repr(Js.null) && isNested(x) { + Obj.repr({depth: (Obj.magic(x): nested).depth + 1}) + } else { + x + } + +let nullable_to_opt = (type t, x: Js.nullable): option => + if Js.isNullable(x) { + None + } else { + Obj.magic(some((Obj.magic(x): 'a))) + } + +let undefined_to_opt = (type t, x: Js.undefined): option => + if Obj.magic(x) === Js.undefined { + None + } else { + Obj.magic(some((Obj.magic(x): 'a))) + } + +let null_to_opt = (type t, x: Js.null): option => + if Obj.magic(x) === Js.null { + None + } else { + Obj.magic(some((Obj.magic(x): 'a))) + } + +/* external valFromOption : 'a option -> 'a = + "#val_from_option" */ + +/** The input is already of [Some] form, [x] is not None, + make sure [x[0]] will not throw */ +let valFromOption = (x: Obj.t): Obj.t => + if x !== Obj.repr(Js.null) && isNested(x) { + let {depth}: nested = Obj.magic(x) + if depth == 0 { + Obj.magic(None) + } else { + Obj.repr({depth: depth - 1}) + } + } else { + Obj.magic(x) + } + +let option_get = (x: option<'a>) => + if x == None { + Caml_undefined_extern.empty + } else { + Obj.magic(valFromOption(Obj.repr(x))) + } + +type poly = { + @as("HASH") hash: int /* Literals.polyvar_hash */, + @as("VAL") value: Obj.t, +} + +/** [input] is optional polymorphic variant */ +let option_unwrap = (x: option) => + switch x { + | None => Obj.repr(x) + | Some(x) => x.value + } diff --git a/jscomp/runtime/caml_option.mli b/jscomp/runtime/caml_option.resi similarity index 70% rename from jscomp/runtime/caml_option.mli rename to jscomp/runtime/caml_option.resi index 6b0d0f6e9f..8755bf77f2 100644 --- a/jscomp/runtime/caml_option.mli +++ b/jscomp/runtime/caml_option.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,32 +17,30 @@ * 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. *) + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -type nested = { - depth : int ; [@bs.as "BS_PRIVATE_NESTED_SOME_NONE"] -} +type nested = {@as("BS_PRIVATE_NESTED_SOME_NONE") depth: int} -val nullable_to_opt : 'a Js.null_undefined -> 'a option +let nullable_to_opt: Js.null_undefined<'a> => option<'a> -val undefined_to_opt : 'a Js.undefined -> 'a option +let undefined_to_opt: Js.undefined<'a> => option<'a> -val null_to_opt : 'a Js.null -> 'a option +let null_to_opt: Js.null<'a> => option<'a> -val valFromOption : Obj.t -> Obj.t +let valFromOption: Obj.t => Obj.t -val some : Obj.t -> Obj.t +let some: Obj.t => Obj.t -val isNested : Obj.t -> bool +let isNested: Obj.t => bool -val option_get : Obj.t option -> Obj.t Caml_undefined_extern.t +let option_get: option => Caml_undefined_extern.t -type poly +type poly -(** When it is None, return none +/** When it is None, return none When it is (Some (`a 3)) return 3 -*) -val option_unwrap : poly option -> Obj.t +*/ +let option_unwrap: option => Obj.t diff --git a/jscomp/runtime/caml_parser.ml b/jscomp/runtime/caml_parser.res similarity index 97% rename from jscomp/runtime/caml_parser.ml rename to jscomp/runtime/caml_parser.res index 8b7fb0c0ce..82add8c00e 100644 --- a/jscomp/runtime/caml_parser.ml +++ b/jscomp/runtime/caml_parser.res @@ -1,7 +1,5 @@ - - -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -19,14 +17,12 @@ * 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. *) - - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -[%%bs.raw{| +%%raw(` /***********************************************************************/ /* */ @@ -90,9 +86,9 @@ var Result = { CALL_ERROR_FUNCTION: 5 }; var PARSER_TRACE = false; -|}] +`) -(** +/* * external parse_engine : parse_tables -> parser_env -> parser_input -> Obj.t -> parser_output * parsing.ml * @@ -146,14 +142,17 @@ var PARSER_TRACE = false; * @param cmd * @param arg * @returns {number} -*) +*/ -type parse_tables -type parser_env +type parse_tables +type parser_env - -let parse_engine : parse_tables -> parser_env -> (*Parsing.parser_input *)Obj.t -> Obj.t -> Obj.t = - [%raw{|function (tables /* parser_table */, env /* parser_env */, cmd /* parser_input*/, arg /* Obj.t*/) { +let parse_engine: ( + parse_tables, + parser_env, + /* Parsing.parser_input */ Obj.t, + Obj.t, +) => Obj.t = %raw(`function (tables /* parser_table */, env /* parser_env */, cmd /* parser_input*/, arg /* Obj.t*/) { var ERRCODE = 256; //var START = 0; //var TOKEN_READ = 1; @@ -376,18 +375,16 @@ let parse_engine : parse_tables -> parser_env -> (*Parsing.parser_input *)Obj.t env[env_state] = state; env[env_errflag] = errflag; return res; -}|}] - +}`) -(** +/** * external set_trace: bool -> bool = "?set_parser_trace" * parsing.ml * @param {boolean} * @returns {boolean} -*) -let set_parser_trace : bool -> bool = [%raw{|function (v) { + */ +let set_parser_trace: bool => bool = %raw(`function (v) { var old = PARSER_TRACE; PARSER_TRACE = v; return old; -}|}] - +}`) diff --git a/jscomp/runtime/caml_lexer.mli b/jscomp/runtime/caml_parser.resi similarity index 82% rename from jscomp/runtime/caml_lexer.mli rename to jscomp/runtime/caml_parser.resi index 14728caf56..57d493c04e 100644 --- a/jscomp/runtime/caml_lexer.mli +++ b/jscomp/runtime/caml_parser.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,23 +17,19 @@ * 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. *) - - - - - - -(* the same as Lexing *) -type lex_tables -type lexbuf + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -val lex_engine : - lex_tables -> int -> lexbuf -> int +type parse_tables +type parser_env +let parse_engine: ( + parse_tables, + parser_env, + Obj.t /* Parsing.parser_input */, + Obj.t, +) => /* parser_output */ Obj.t -val new_lex_engine : - lex_tables -> int -> lexbuf -> int +let set_parser_trace: bool => bool diff --git a/jscomp/runtime/caml_splice_call.ml b/jscomp/runtime/caml_splice_call.res similarity index 85% rename from jscomp/runtime/caml_splice_call.ml rename to jscomp/runtime/caml_splice_call.res index 43d9b98a04..7c2334c084 100644 --- a/jscomp/runtime/caml_splice_call.ml +++ b/jscomp/runtime/caml_splice_call.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2019- Hongbo Zhang, Authors of ReScript - * +/* Copyright (C) 2019- 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 @@ -17,14 +17,14 @@ * 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. *) + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ type obj = Obj.t -let spliceApply : obj -> obj -> obj = [%raw{|function(fn,args){ +let spliceApply: (obj, obj) => obj = %raw(`function(fn,args){ var i, argLen; argLen = args.length var applied = [] @@ -36,12 +36,12 @@ let spliceApply : obj -> obj -> obj = [%raw{|function(fn,args){ applied.push(lastOne[i]) } return fn.apply(null,applied) -}|}] +}`) -let spliceNewApply : obj -> obj -> obj = [%raw{|function (ctor,args){ +let spliceNewApply: (obj, obj) => obj = %raw(`function (ctor,args){ var i, argLen; argLen = args.length - var applied = [null] // Function.prototype.bind.apply(fn, args) requires the first element in `args` to be `null` + var applied = [null] // Function.prototype.bind.apply(fn, args) requires the first element in \`args\` to be \`null\` for(i = 0; i < argLen - 1; ++i){ applied.push(args[i]) } @@ -51,9 +51,9 @@ let spliceNewApply : obj -> obj -> obj = [%raw{|function (ctor,args){ } var C = Function.prototype.bind.apply(ctor, applied) return new C() -}|}] +}`) -let spliceObjApply : obj -> obj -> obj -> obj = [%raw{|function(obj,name,args){ +let spliceObjApply: (obj, obj, obj) => obj = %raw(`function(obj,name,args){ var i, argLen; argLen = args.length var applied = [] @@ -65,5 +65,4 @@ let spliceObjApply : obj -> obj -> obj -> obj = [%raw{|function(obj,name,args){ applied.push(lastOne[i]) } return (obj[name]).apply(obj,applied) -}|}] - +}`) diff --git a/jscomp/runtime/caml_splice_call.mli b/jscomp/runtime/caml_splice_call.resi similarity index 86% rename from jscomp/runtime/caml_splice_call.mli rename to jscomp/runtime/caml_splice_call.resi index ac53fc1ea7..16480895bd 100644 --- a/jscomp/runtime/caml_splice_call.mli +++ b/jscomp/runtime/caml_splice_call.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2019- Authors of ReScript - * +/* Copyright (C) 2019- 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 @@ -17,16 +17,15 @@ * 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. *) - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ type obj = Obj.t -val spliceApply : obj -> obj -> obj +let spliceApply: (obj, obj) => obj -val spliceNewApply : obj -> obj -> obj +let spliceNewApply: (obj, obj) => obj -val spliceObjApply : obj -> obj -> obj -> obj \ No newline at end of file +let spliceObjApply: (obj, obj, obj) => obj diff --git a/jscomp/runtime/caml_string.ml b/jscomp/runtime/caml_string.res similarity index 74% rename from jscomp/runtime/caml_string.ml rename to jscomp/runtime/caml_string.res index fae7711860..c70e95cf1f 100644 --- a/jscomp/runtime/caml_string.ml +++ b/jscomp/runtime/caml_string.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,26 +17,23 @@ * 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. *) + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -(***********************) -(* replaced primitives *) -(* Note that we explicitly define [unsafe_set] instead of +/* ********************* */ +/* replaced primitives */ +/* Note that we explicitly define [unsafe_set] instead of using {!Bytes.unsafe_set} since for some standard libraries, it might point to ["%string_unsafe_set"] -*) - - - -let get s i= - if i >=Caml_string_extern.length s || i < 0 then - raise (Invalid_argument "index out of bounds") - else Caml_string_extern.unsafe_get s i +*/ -let make n (ch : char) : string = - (Caml_string_extern.of_char ch) - |. Caml_string_extern.repeat n +let get = (s, i) => + if i >= Caml_string_extern.length(s) || i < 0 { + raise(Invalid_argument("index out of bounds")) + } else { + Caml_string_extern.unsafe_get(s, i) + } +let make = (n, ch: char): string => Caml_string_extern.of_char(ch)->Caml_string_extern.repeat(n) diff --git a/jscomp/runtime/caml_int32.mli b/jscomp/runtime/caml_string.resi similarity index 90% rename from jscomp/runtime/caml_int32.mli rename to jscomp/runtime/caml_string.resi index d59ec17e92..162eab1887 100644 --- a/jscomp/runtime/caml_int32.mli +++ b/jscomp/runtime/caml_string.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,15 +17,11 @@ * 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. *) - - - -val div : int -> int -> int - -val mod_ : int -> int -> int + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +let get: (string, int) => char +let make: (int, char) => string diff --git a/jscomp/runtime/caml_string_extern.ml b/jscomp/runtime/caml_string_extern.res similarity index 52% rename from jscomp/runtime/caml_string_extern.ml rename to jscomp/runtime/caml_string_extern.res index fb8fb309d7..57942ca957 100644 --- a/jscomp/runtime/caml_string_extern.ml +++ b/jscomp/runtime/caml_string_extern.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,54 +17,38 @@ * 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. *) - -(** *) + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -(** TODO: check with {!String.of_char} +/*** TODO: check with {!String.of_char} it's quite common that we have {[ Caml_string_extern.of_char x.[0] ]} It would be nice to generate code as below {[ x[0] ]} -*) - -(*ATT: this relies on we encode `char' as int *) -external of_char : char -> string = "String.fromCharCode" -[@@bs.val] -external get_string_unsafe : string -> int -> string = "" -[@@bs.get_index] - -external toUpperCase : string -> string = "toUpperCase" [@@bs.send] -external of_int : int -> base:int -> string = "toString" [@@bs.send] -external slice : string -> int -> int -> string = "slice" -[@@bs.send] -external slice_rest : string -> int -> string = "slice" -[@@bs.send] -external index_of : string -> string -> int = "indexOf" -[@@bs.send] +*/ -external of_small_int_array : - (_ [@bs.as {json|null|json}] ) -> - int array -> string = - "String.fromCharCode.apply" -[@@bs.val] +/* ATT: this relies on we encode `char' as int */ +@val external of_char: char => string = "String.fromCharCode" +@get_index external get_string_unsafe: (string, int) => string = "" -external of_small_int32_array : - int array -> string = - "String.fromCharCode" -[@@bs.val] [@@bs.splice] +@send external toUpperCase: string => string = "toUpperCase" +@send external of_int: (int, ~base: int) => string = "toString" +@send external slice: (string, int, int) => string = "slice" +@send external slice_rest: (string, int) => string = "slice" +@send external index_of: (string, string) => int = "indexOf" -external lastIndexOf : string -> string -> int = "lastIndexOf" -[@@bs.send] (* used in {!Caml_io} *) +@val +external of_small_int_array: (@as(json`null`) _, array) => string = "String.fromCharCode.apply" +@val @variadic external of_small_int32_array: array => string = "String.fromCharCode" +@send external lastIndexOf: (string, string) => int = "lastIndexOf" /* used in {!Caml_io} */ -external length : string -> int = "%string_length" -external unsafe_get : string -> int -> char = "%string_unsafe_get" -external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" +external length: string => int = "%string_length" +external unsafe_get: (string, int) => char = "%string_unsafe_get" +external unsafe_set: (bytes, int, char) => unit = "%bytes_unsafe_set" -external repeat : string -> int -> string = "repeat" [@@bs.send] +@send external repeat: (string, int) => string = "repeat" diff --git a/jscomp/runtime/caml_sys.ml b/jscomp/runtime/caml_sys.res similarity index 53% rename from jscomp/runtime/caml_sys.ml rename to jscomp/runtime/caml_sys.res index 382ece0d96..01850a8e96 100644 --- a/jscomp/runtime/caml_sys.ml +++ b/jscomp/runtime/caml_sys.res @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,56 +17,56 @@ * 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. *) - - - -external getEnv : 'a -> string -> string option = "" [@@bs.get_index] -let sys_getenv s = - if Js.typeof [%raw{|process|}] = "undefined" - || [%raw{|process.env|}] = Caml_undefined_extern.empty - then raise Not_found - else - match getEnv [%raw{|process.env|}] s with - | None -> raise Not_found - | Some x -> x + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +@get_index external getEnv: ('a, string) => option = "" +let sys_getenv = s => + if ( + Js.typeof(%raw(`process`)) == "undefined" || %raw(`process.env`) == Caml_undefined_extern.empty + ) { + raise(Not_found) + } else { + switch getEnv(%raw(`process.env`), s) { + | None => raise(Not_found) + | Some(x) => x + } + } -(* https://nodejs.org/dist/latest-v12.x/docs/api/os.html#os_os_platform +/* https://nodejs.org/dist/latest-v12.x/docs/api/os.html#os_os_platform The value is set at compile time. Possible values are 'aix', 'darwin','freebsd', 'linux', 'openbsd', 'sunos', and 'win32'. The return value is equivalent to process.platform. NodeJS does not support Cygwin very well -*) -let os_type : unit -> string = [%raw{|function(_){ +*/ +let os_type: unit => string = %raw(`function(_){ if(typeof process !== 'undefined' && process.platform === 'win32'){ return "Win32" } else { return "Unix" } -}|}] -(* TODO: improve [js_pass_scope] to avoid remove unused n here *) - - +}`) +/* TODO: improve [js_pass_scope] to avoid remove unused n here */ -(* let initial_time = now () *. 0.001 *) +/* let initial_time = now () *. 0.001 */ type process -external uptime : process -> unit -> float = "uptime" [@@bs.send] -external exit : process -> int -> 'a = "exit" [@@bs.send] - -let sys_time () = - if Js.typeof [%raw{|process|}] = "undefined" - || [%raw{|process.uptime|}] = Caml_undefined_extern.empty - then -1. - else uptime [%raw{|process|}] () - - - +@send external uptime: (process, unit) => float = "uptime" +@send external exit: (process, int) => 'a = "exit" + +let sys_time = () => + if ( + Js.typeof(%raw(`process`)) == "undefined" || + %raw(`process.uptime`) == Caml_undefined_extern.empty + ) { + -1. + } else { + uptime(%raw(`process`), ()) + } -(* +/* type spawnResult external spawnSync : string -> spawnResult = "spawnSync" [@@bs.module "child_process"] @@ -75,39 +75,37 @@ external readAs : spawnResult -> status : int Js.null; > Js.t = "%identity" -*) - +*/ - -let sys_getcwd : unit -> string = [%raw{|function(param){ +let sys_getcwd: unit => string = %raw(`function(param){ if (typeof process === "undefined" || process.cwd === undefined){ return "/" } return process.cwd() - }|}] - - -(* Called by {!Sys} in the toplevel, should never fail*) -let sys_get_argv () : string * string array = - if Js.typeof [%raw{|process|}] = "undefined" then "",[|""|] - else - let argv = [%raw{|process.argv|}] in - if Js.testAny argv then ("",[|""|]) - else Caml_array_extern.unsafe_get argv 0, argv - -(** {!Pervasives.sys_exit} *) -let sys_exit :int -> 'a = fun exit_code -> - if Js.typeof [%raw{|process|}] <> "undefined" then - exit [%raw{|process|}] exit_code - + }`) + +/* Called by {!Sys} in the toplevel, should never fail */ +let sys_get_argv = (): (string, array) => + if Js.typeof(%raw(`process`)) == "undefined" { + ("", [""]) + } else { + let argv = %raw(`process.argv`) + if Js.testAny(argv) { + ("", [""]) + } else { + (Caml_array_extern.unsafe_get(argv, 0), argv) + } + } +/** {!Pervasives.sys_exit} */ +let sys_exit: int => 'a = exit_code => + if Js.typeof(%raw(`process`)) != "undefined" { + exit(%raw(`process`), exit_code) + } -let sys_is_directory _s = - raise (Failure "sys_is_directory not implemented") +let sys_is_directory = _s => raise(Failure("sys_is_directory not implemented")) -(** Need polyfill to make cmdliner work +/** Need polyfill to make cmdliner work {!Sys.is_directory} or {!Sys.file_exists} {!Sys.command} -*) -let sys_file_exists _s = - raise ( Failure "sys_file_exists not implemented") - +*/ +let sys_file_exists = _s => raise(Failure("sys_file_exists not implemented")) diff --git a/jscomp/runtime/caml_parser.mli b/jscomp/runtime/caml_sys.resi similarity index 78% rename from jscomp/runtime/caml_parser.mli rename to jscomp/runtime/caml_sys.resi index e6fb278f93..8ebc0c158a 100644 --- a/jscomp/runtime/caml_parser.mli +++ b/jscomp/runtime/caml_sys.resi @@ -1,5 +1,5 @@ -(* Copyright (C) 2015-2016 Bloomberg Finance L.P. - * +/* Copyright (C) 2015-2016 Bloomberg Finance L.P. + * * 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 @@ -17,23 +17,22 @@ * 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. *) - + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ +let sys_getenv: string => string +let sys_time: unit => float -(** *) -type parse_tables -type parser_env +let os_type: unit => string -val parse_engine : - parse_tables -> parser_env -> - Obj.t (* Parsing.parser_input *) -> Obj.t -> - (* parser_output *) Obj.t +let sys_getcwd: unit => string +let sys_get_argv: unit => (string, array) +let sys_exit: int => unit -val set_parser_trace : bool -> bool +let sys_is_directory: string => bool +let sys_file_exists: string => bool diff --git a/jscomp/runtime/caml_undefined_extern.ml b/jscomp/runtime/caml_undefined_extern.ml deleted file mode 100644 index 130bf5b04e..0000000000 --- a/jscomp/runtime/caml_undefined_extern.ml +++ /dev/null @@ -1,4 +0,0 @@ -type + 'a t -external empty : 'a t = "#undefined" -external return : 'a -> 'a t = "%identity" -external toOption : 'a t -> 'a option = "#undefined_to_opt" \ No newline at end of file diff --git a/jscomp/runtime/caml_undefined_extern.res b/jscomp/runtime/caml_undefined_extern.res new file mode 100644 index 0000000000..a34355edb1 --- /dev/null +++ b/jscomp/runtime/caml_undefined_extern.res @@ -0,0 +1,4 @@ +type t<+'a> +external empty: t<'a> = "#undefined" +external return: 'a => t<'a> = "%identity" +external toOption: t<'a> => option<'a> = "#undefined_to_opt" diff --git a/jscomp/runtime/curry.ml b/jscomp/runtime/curry.ml deleted file mode 100644 index 6c460fae78..0000000000 --- a/jscomp/runtime/curry.ml +++ /dev/null @@ -1,263 +0,0 @@ - -(* Copyright (C) 2015 - 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. *) - -(* Generated by scripts/curry_gen.ml *) -external function_length : 'a -> int = "#function_length" -external apply_args : ('a -> 'b) -> _ array -> 'b = "#apply" - -let _ = Caml_array.sub (* make the build dependency on Caml_array explicit *) -let%private sub = Caml_array.sub -(* Public *) -let rec app f args = - let init_arity = function_length f in - let arity = if init_arity = 0 then 1 else init_arity in (* arity fixing *) - let len = Caml_array_extern.length args in - let d = arity - len in - if d = 0 then - apply_args f args (* f.apply (null,args) *) - else if d < 0 then - (* TODO: could avoid copy by tracking the index *) - app (Obj.magic (apply_args f (sub args 0 arity))) - (sub args arity (-d)) - else - Obj.magic (fun x -> app f (Caml_array_extern.append args [|x|] )) - - -(* Internal use *) -external apply1 : ('a0 -> 'a1) -> 'a0 -> 'a1 = "#apply1" -(* Internal use *) -external apply2 : ('a0 -> 'a1 -> 'a2) -> 'a0 -> 'a1 -> 'a2 = "#apply2" -(* Internal use *) -external apply3 : ('a0 -> 'a1 -> 'a2 -> 'a3) -> 'a0 -> 'a1 -> 'a2 -> 'a3 = "#apply3" -(* Internal use *) -external apply4 : ('a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4) -> 'a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 = "#apply4" -(* Internal use *) -external apply5 : ('a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5) -> 'a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 = "#apply5" -(* Internal use *) -external apply6 : ('a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6) -> 'a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 = "#apply6" -(* Internal use *) -external apply7 : ('a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 -> 'a7) -> 'a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 -> 'a7 = "#apply7" -(* Internal use *) -external apply8 : ('a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 -> 'a7 -> 'a8) -> 'a0 -> 'a1 -> 'a2 -> 'a3 -> 'a4 -> 'a5 -> 'a6 -> 'a7 -> 'a8 = "#apply8" - - -let %private curry_1 o a0 arity = - match arity with - | 1 -> apply1 (Obj.magic o) a0 - | 2 -> apply2 (Obj.magic o) a0 - | 3 -> apply3 (Obj.magic o) a0 - | 4 -> apply4 (Obj.magic o) a0 - | 5 -> apply5 (Obj.magic o) a0 - | 6 -> apply6 (Obj.magic o) a0 - | 7 -> apply7 (Obj.magic o) a0 - | _ -> Obj.magic (app o [|a0|]) - -(* Public *) -let _1 o a0 = - let arity = function_length o in - if arity = 1 then apply1 o a0 - else curry_1 o a0 arity - -(* Public *) -let __1 o = - let arity = function_length o in - if arity = 1 then o - else fun a0 -> _1 o a0 - - - -let %private curry_2 o a0 a1 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1|] - | 2 -> apply2 (Obj.magic o) a0 a1 - | 3 -> apply3 (Obj.magic o) a0 a1 - | 4 -> apply4 (Obj.magic o) a0 a1 - | 5 -> apply5 (Obj.magic o) a0 a1 - | 6 -> apply6 (Obj.magic o) a0 a1 - | 7 -> apply7 (Obj.magic o) a0 a1 - | _ -> Obj.magic (app o [|a0;a1|]) - -(* Public *) -let _2 o a0 a1 = - let arity = function_length o in - if arity = 2 then apply2 o a0 a1 - else curry_2 o a0 a1 arity - -(* Public *) -let __2 o = - let arity = function_length o in - if arity = 2 then o - else fun a0 a1 -> _2 o a0 a1 - - - -let %private curry_3 o a0 a1 a2 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1;a2|] - | 2 -> app (apply2 (Obj.magic o) a0 a1) [|a2|] - | 3 -> apply3 (Obj.magic o) a0 a1 a2 - | 4 -> apply4 (Obj.magic o) a0 a1 a2 - | 5 -> apply5 (Obj.magic o) a0 a1 a2 - | 6 -> apply6 (Obj.magic o) a0 a1 a2 - | 7 -> apply7 (Obj.magic o) a0 a1 a2 - | _ -> Obj.magic (app o [|a0;a1;a2|]) - -(* Public *) -let _3 o a0 a1 a2 = - let arity = function_length o in - if arity = 3 then apply3 o a0 a1 a2 - else curry_3 o a0 a1 a2 arity - -(* Public *) -let __3 o = - let arity = function_length o in - if arity = 3 then o - else fun a0 a1 a2 -> _3 o a0 a1 a2 - - - -let %private curry_4 o a0 a1 a2 a3 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1;a2;a3|] - | 2 -> app (apply2 (Obj.magic o) a0 a1) [|a2;a3|] - | 3 -> app (apply3 (Obj.magic o) a0 a1 a2) [|a3|] - | 4 -> apply4 (Obj.magic o) a0 a1 a2 a3 - | 5 -> apply5 (Obj.magic o) a0 a1 a2 a3 - | 6 -> apply6 (Obj.magic o) a0 a1 a2 a3 - | 7 -> apply7 (Obj.magic o) a0 a1 a2 a3 - | _ -> Obj.magic (app o [|a0;a1;a2;a3|]) - -(* Public *) -let _4 o a0 a1 a2 a3 = - let arity = function_length o in - if arity = 4 then apply4 o a0 a1 a2 a3 - else curry_4 o a0 a1 a2 a3 arity - -(* Public *) -let __4 o = - let arity = function_length o in - if arity = 4 then o - else fun a0 a1 a2 a3 -> _4 o a0 a1 a2 a3 - - - -let %private curry_5 o a0 a1 a2 a3 a4 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1;a2;a3;a4|] - | 2 -> app (apply2 (Obj.magic o) a0 a1) [|a2;a3;a4|] - | 3 -> app (apply3 (Obj.magic o) a0 a1 a2) [|a3;a4|] - | 4 -> app (apply4 (Obj.magic o) a0 a1 a2 a3) [|a4|] - | 5 -> apply5 (Obj.magic o) a0 a1 a2 a3 a4 - | 6 -> apply6 (Obj.magic o) a0 a1 a2 a3 a4 - | 7 -> apply7 (Obj.magic o) a0 a1 a2 a3 a4 - | _ -> Obj.magic (app o [|a0;a1;a2;a3;a4|]) - -(* Public *) -let _5 o a0 a1 a2 a3 a4 = - let arity = function_length o in - if arity = 5 then apply5 o a0 a1 a2 a3 a4 - else curry_5 o a0 a1 a2 a3 a4 arity - -(* Public *) -let __5 o = - let arity = function_length o in - if arity = 5 then o - else fun a0 a1 a2 a3 a4 -> _5 o a0 a1 a2 a3 a4 - - - -let %private curry_6 o a0 a1 a2 a3 a4 a5 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1;a2;a3;a4;a5|] - | 2 -> app (apply2 (Obj.magic o) a0 a1) [|a2;a3;a4;a5|] - | 3 -> app (apply3 (Obj.magic o) a0 a1 a2) [|a3;a4;a5|] - | 4 -> app (apply4 (Obj.magic o) a0 a1 a2 a3) [|a4;a5|] - | 5 -> app (apply5 (Obj.magic o) a0 a1 a2 a3 a4) [|a5|] - | 6 -> apply6 (Obj.magic o) a0 a1 a2 a3 a4 a5 - | 7 -> apply7 (Obj.magic o) a0 a1 a2 a3 a4 a5 - | _ -> Obj.magic (app o [|a0;a1;a2;a3;a4;a5|]) - -(* Public *) -let _6 o a0 a1 a2 a3 a4 a5 = - let arity = function_length o in - if arity = 6 then apply6 o a0 a1 a2 a3 a4 a5 - else curry_6 o a0 a1 a2 a3 a4 a5 arity - -(* Public *) -let __6 o = - let arity = function_length o in - if arity = 6 then o - else fun a0 a1 a2 a3 a4 a5 -> _6 o a0 a1 a2 a3 a4 a5 - - - -let %private curry_7 o a0 a1 a2 a3 a4 a5 a6 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1;a2;a3;a4;a5;a6|] - | 2 -> app (apply2 (Obj.magic o) a0 a1) [|a2;a3;a4;a5;a6|] - | 3 -> app (apply3 (Obj.magic o) a0 a1 a2) [|a3;a4;a5;a6|] - | 4 -> app (apply4 (Obj.magic o) a0 a1 a2 a3) [|a4;a5;a6|] - | 5 -> app (apply5 (Obj.magic o) a0 a1 a2 a3 a4) [|a5;a6|] - | 6 -> app (apply6 (Obj.magic o) a0 a1 a2 a3 a4 a5) [|a6|] - | 7 -> apply7 (Obj.magic o) a0 a1 a2 a3 a4 a5 a6 - | _ -> Obj.magic (app o [|a0;a1;a2;a3;a4;a5;a6|]) - -(* Public *) -let _7 o a0 a1 a2 a3 a4 a5 a6 = - let arity = function_length o in - if arity = 7 then apply7 o a0 a1 a2 a3 a4 a5 a6 - else curry_7 o a0 a1 a2 a3 a4 a5 a6 arity - -(* Public *) -let __7 o = - let arity = function_length o in - if arity = 7 then o - else fun a0 a1 a2 a3 a4 a5 a6 -> _7 o a0 a1 a2 a3 a4 a5 a6 - - - -let %private curry_8 o a0 a1 a2 a3 a4 a5 a6 a7 arity = - match arity with - | 1 -> app (apply1 (Obj.magic o) a0) [|a1;a2;a3;a4;a5;a6;a7|] - | 2 -> app (apply2 (Obj.magic o) a0 a1) [|a2;a3;a4;a5;a6;a7|] - | 3 -> app (apply3 (Obj.magic o) a0 a1 a2) [|a3;a4;a5;a6;a7|] - | 4 -> app (apply4 (Obj.magic o) a0 a1 a2 a3) [|a4;a5;a6;a7|] - | 5 -> app (apply5 (Obj.magic o) a0 a1 a2 a3 a4) [|a5;a6;a7|] - | 6 -> app (apply6 (Obj.magic o) a0 a1 a2 a3 a4 a5) [|a6;a7|] - | 7 -> app (apply7 (Obj.magic o) a0 a1 a2 a3 a4 a5 a6) [|a7|] - | _ -> Obj.magic (app o [|a0;a1;a2;a3;a4;a5;a6;a7|]) - -(* Public *) -let _8 o a0 a1 a2 a3 a4 a5 a6 a7 = - let arity = function_length o in - if arity = 8 then apply8 o a0 a1 a2 a3 a4 a5 a6 a7 - else curry_8 o a0 a1 a2 a3 a4 a5 a6 a7 arity - -(* Public *) -let __8 o = - let arity = function_length o in - if arity = 8 then o - else fun a0 a1 a2 a3 a4 a5 a6 a7 -> _8 o a0 a1 a2 a3 a4 a5 a6 a7 - diff --git a/jscomp/runtime/curry.res b/jscomp/runtime/curry.res new file mode 100644 index 0000000000..7d2fff69ab --- /dev/null +++ b/jscomp/runtime/curry.res @@ -0,0 +1,358 @@ +/* Copyright (C) 2015 - 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. */ + +/* Generated by scripts/curry_gen.ml */ +external function_length: 'a => int = "#function_length" +external apply_args: ('a => 'b, array<_>) => 'b = "#apply" + +let _ = Caml_array.sub /* make the build dependency on Caml_array explicit */ +%%private(let sub = Caml_array.sub) +/* Public */ +let rec app = (f, args) => { + let init_arity = function_length(f) + let arity = if init_arity == 0 { + 1 + } else { + init_arity + } /* arity fixing */ + let len = Caml_array_extern.length(args) + let d = arity - len + if d == 0 { + apply_args(f, args) /* f.apply (null,args) */ + } else if d < 0 { + /* TODO: could avoid copy by tracking the index */ + app(Obj.magic(apply_args(f, sub(args, 0, arity))), sub(args, arity, -d)) + } else { + Obj.magic(x => app(f, Caml_array_extern.append(args, [x]))) + } +} + +/* Internal use */ +external apply1: ('a0 => 'a1, 'a0) => 'a1 = "#apply1" +/* Internal use */ +external apply2: (('a0, 'a1) => 'a2, 'a0, 'a1) => 'a2 = "#apply2" +/* Internal use */ +external apply3: (('a0, 'a1, 'a2) => 'a3, 'a0, 'a1, 'a2) => 'a3 = "#apply3" +/* Internal use */ +external apply4: (('a0, 'a1, 'a2, 'a3) => 'a4, 'a0, 'a1, 'a2, 'a3) => 'a4 = "#apply4" +/* Internal use */ +external apply5: (('a0, 'a1, 'a2, 'a3, 'a4) => 'a5, 'a0, 'a1, 'a2, 'a3, 'a4) => 'a5 = "#apply5" +/* Internal use */ +external apply6: (('a0, 'a1, 'a2, 'a3, 'a4, 'a5) => 'a6, 'a0, 'a1, 'a2, 'a3, 'a4, 'a5) => 'a6 = + "#apply6" +/* Internal use */ +external apply7: ( + ('a0, 'a1, 'a2, 'a3, 'a4, 'a5, 'a6) => 'a7, + 'a0, + 'a1, + 'a2, + 'a3, + 'a4, + 'a5, + 'a6, +) => 'a7 = "#apply7" +/* Internal use */ +external apply8: ( + ('a0, 'a1, 'a2, 'a3, 'a4, 'a5, 'a6, 'a7) => 'a8, + 'a0, + 'a1, + 'a2, + 'a3, + 'a4, + 'a5, + 'a6, + 'a7, +) => 'a8 = "#apply8" + +%%private( + let curry_1 = (o, a0, arity) => + switch arity { + | 1 => apply1(Obj.magic(o), a0) + | 2 => apply2(Obj.magic(o), a0) + | 3 => apply3(Obj.magic(o), a0) + | 4 => apply4(Obj.magic(o), a0) + | 5 => apply5(Obj.magic(o), a0) + | 6 => apply6(Obj.magic(o), a0) + | 7 => apply7(Obj.magic(o), a0) + | _ => Obj.magic(app(o, [a0])) + } +) + +/* Public */ +let _1 = (o, a0) => { + let arity = function_length(o) + if arity == 1 { + apply1(o, a0) + } else { + curry_1(o, a0, arity) + } +} + +/* Public */ +let __1 = o => { + let arity = function_length(o) + if arity == 1 { + o + } else { + a0 => _1(o, a0) + } +} + +%%private( + let curry_2 = (o, a0, a1, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1]) + | 2 => apply2(Obj.magic(o), a0, a1) + | 3 => apply3(Obj.magic(o), a0, a1) + | 4 => apply4(Obj.magic(o), a0, a1) + | 5 => apply5(Obj.magic(o), a0, a1) + | 6 => apply6(Obj.magic(o), a0, a1) + | 7 => apply7(Obj.magic(o), a0, a1) + | _ => Obj.magic(app(o, [a0, a1])) + } +) + +/* Public */ +let _2 = (o, a0, a1) => { + let arity = function_length(o) + if arity == 2 { + apply2(o, a0, a1) + } else { + curry_2(o, a0, a1, arity) + } +} + +/* Public */ +let __2 = o => { + let arity = function_length(o) + if arity == 2 { + o + } else { + (a0, a1) => _2(o, a0, a1) + } +} + +%%private( + let curry_3 = (o, a0, a1, a2, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1, a2]) + | 2 => app(apply2(Obj.magic(o), a0, a1), [a2]) + | 3 => apply3(Obj.magic(o), a0, a1, a2) + | 4 => apply4(Obj.magic(o), a0, a1, a2) + | 5 => apply5(Obj.magic(o), a0, a1, a2) + | 6 => apply6(Obj.magic(o), a0, a1, a2) + | 7 => apply7(Obj.magic(o), a0, a1, a2) + | _ => Obj.magic(app(o, [a0, a1, a2])) + } +) + +/* Public */ +let _3 = (o, a0, a1, a2) => { + let arity = function_length(o) + if arity == 3 { + apply3(o, a0, a1, a2) + } else { + curry_3(o, a0, a1, a2, arity) + } +} + +/* Public */ +let __3 = o => { + let arity = function_length(o) + if arity == 3 { + o + } else { + (a0, a1, a2) => _3(o, a0, a1, a2) + } +} + +%%private( + let curry_4 = (o, a0, a1, a2, a3, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1, a2, a3]) + | 2 => app(apply2(Obj.magic(o), a0, a1), [a2, a3]) + | 3 => app(apply3(Obj.magic(o), a0, a1, a2), [a3]) + | 4 => apply4(Obj.magic(o), a0, a1, a2, a3) + | 5 => apply5(Obj.magic(o), a0, a1, a2, a3) + | 6 => apply6(Obj.magic(o), a0, a1, a2, a3) + | 7 => apply7(Obj.magic(o), a0, a1, a2, a3) + | _ => Obj.magic(app(o, [a0, a1, a2, a3])) + } +) + +/* Public */ +let _4 = (o, a0, a1, a2, a3) => { + let arity = function_length(o) + if arity == 4 { + apply4(o, a0, a1, a2, a3) + } else { + curry_4(o, a0, a1, a2, a3, arity) + } +} + +/* Public */ +let __4 = o => { + let arity = function_length(o) + if arity == 4 { + o + } else { + (a0, a1, a2, a3) => _4(o, a0, a1, a2, a3) + } +} + +%%private( + let curry_5 = (o, a0, a1, a2, a3, a4, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1, a2, a3, a4]) + | 2 => app(apply2(Obj.magic(o), a0, a1), [a2, a3, a4]) + | 3 => app(apply3(Obj.magic(o), a0, a1, a2), [a3, a4]) + | 4 => app(apply4(Obj.magic(o), a0, a1, a2, a3), [a4]) + | 5 => apply5(Obj.magic(o), a0, a1, a2, a3, a4) + | 6 => apply6(Obj.magic(o), a0, a1, a2, a3, a4) + | 7 => apply7(Obj.magic(o), a0, a1, a2, a3, a4) + | _ => Obj.magic(app(o, [a0, a1, a2, a3, a4])) + } +) + +/* Public */ +let _5 = (o, a0, a1, a2, a3, a4) => { + let arity = function_length(o) + if arity == 5 { + apply5(o, a0, a1, a2, a3, a4) + } else { + curry_5(o, a0, a1, a2, a3, a4, arity) + } +} + +/* Public */ +let __5 = o => { + let arity = function_length(o) + if arity == 5 { + o + } else { + (a0, a1, a2, a3, a4) => _5(o, a0, a1, a2, a3, a4) + } +} + +%%private( + let curry_6 = (o, a0, a1, a2, a3, a4, a5, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1, a2, a3, a4, a5]) + | 2 => app(apply2(Obj.magic(o), a0, a1), [a2, a3, a4, a5]) + | 3 => app(apply3(Obj.magic(o), a0, a1, a2), [a3, a4, a5]) + | 4 => app(apply4(Obj.magic(o), a0, a1, a2, a3), [a4, a5]) + | 5 => app(apply5(Obj.magic(o), a0, a1, a2, a3, a4), [a5]) + | 6 => apply6(Obj.magic(o), a0, a1, a2, a3, a4, a5) + | 7 => apply7(Obj.magic(o), a0, a1, a2, a3, a4, a5) + | _ => Obj.magic(app(o, [a0, a1, a2, a3, a4, a5])) + } +) + +/* Public */ +let _6 = (o, a0, a1, a2, a3, a4, a5) => { + let arity = function_length(o) + if arity == 6 { + apply6(o, a0, a1, a2, a3, a4, a5) + } else { + curry_6(o, a0, a1, a2, a3, a4, a5, arity) + } +} + +/* Public */ +let __6 = o => { + let arity = function_length(o) + if arity == 6 { + o + } else { + (a0, a1, a2, a3, a4, a5) => _6(o, a0, a1, a2, a3, a4, a5) + } +} + +%%private( + let curry_7 = (o, a0, a1, a2, a3, a4, a5, a6, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1, a2, a3, a4, a5, a6]) + | 2 => app(apply2(Obj.magic(o), a0, a1), [a2, a3, a4, a5, a6]) + | 3 => app(apply3(Obj.magic(o), a0, a1, a2), [a3, a4, a5, a6]) + | 4 => app(apply4(Obj.magic(o), a0, a1, a2, a3), [a4, a5, a6]) + | 5 => app(apply5(Obj.magic(o), a0, a1, a2, a3, a4), [a5, a6]) + | 6 => app(apply6(Obj.magic(o), a0, a1, a2, a3, a4, a5), [a6]) + | 7 => apply7(Obj.magic(o), a0, a1, a2, a3, a4, a5, a6) + | _ => Obj.magic(app(o, [a0, a1, a2, a3, a4, a5, a6])) + } +) + +/* Public */ +let _7 = (o, a0, a1, a2, a3, a4, a5, a6) => { + let arity = function_length(o) + if arity == 7 { + apply7(o, a0, a1, a2, a3, a4, a5, a6) + } else { + curry_7(o, a0, a1, a2, a3, a4, a5, a6, arity) + } +} + +/* Public */ +let __7 = o => { + let arity = function_length(o) + if arity == 7 { + o + } else { + (a0, a1, a2, a3, a4, a5, a6) => _7(o, a0, a1, a2, a3, a4, a5, a6) + } +} + +%%private( + let curry_8 = (o, a0, a1, a2, a3, a4, a5, a6, a7, arity) => + switch arity { + | 1 => app(apply1(Obj.magic(o), a0), [a1, a2, a3, a4, a5, a6, a7]) + | 2 => app(apply2(Obj.magic(o), a0, a1), [a2, a3, a4, a5, a6, a7]) + | 3 => app(apply3(Obj.magic(o), a0, a1, a2), [a3, a4, a5, a6, a7]) + | 4 => app(apply4(Obj.magic(o), a0, a1, a2, a3), [a4, a5, a6, a7]) + | 5 => app(apply5(Obj.magic(o), a0, a1, a2, a3, a4), [a5, a6, a7]) + | 6 => app(apply6(Obj.magic(o), a0, a1, a2, a3, a4, a5), [a6, a7]) + | 7 => app(apply7(Obj.magic(o), a0, a1, a2, a3, a4, a5, a6), [a7]) + | _ => Obj.magic(app(o, [a0, a1, a2, a3, a4, a5, a6, a7])) + } +) + +/* Public */ +let _8 = (o, a0, a1, a2, a3, a4, a5, a6, a7) => { + let arity = function_length(o) + if arity == 8 { + apply8(o, a0, a1, a2, a3, a4, a5, a6, a7) + } else { + curry_8(o, a0, a1, a2, a3, a4, a5, a6, a7, arity) + } +} + +/* Public */ +let __8 = o => { + let arity = function_length(o) + if arity == 8 { + o + } else { + (a0, a1, a2, a3, a4, a5, a6, a7) => _8(o, a0, a1, a2, a3, a4, a5, a6, a7) + } +} diff --git a/jscomp/runtime/release.ninja b/jscomp/runtime/release.ninja index 36ec0ef5aa..b7b44625e4 100644 --- a/jscomp/runtime/release.ninja +++ b/jscomp/runtime/release.ninja @@ -9,54 +9,54 @@ rule cc_cmi command = $bsc -bs-read-cmi -bs-cmi -bs-cmj $bsc_flags -I runtime $in description = $in -> $out -o runtime/bs_stdlib_mini.cmi : cc runtime/bs_stdlib_mini.mli +o runtime/bs_stdlib_mini.cmi : cc runtime/bs_stdlib_mini.resi bsc_flags = -nostdlib -nopervasives o runtime/js.cmj runtime/js.cmi : cc runtime/js.ml bsc_flags = $bsc_no_open_flags -o runtime/caml.cmj : cc_cmi runtime/caml.ml | runtime/caml.cmi runtime/caml_int64_extern.cmj -o runtime/caml.cmi : cc runtime/caml.mli | runtime/bs_stdlib_mini.cmi runtime/caml_int64_extern.cmj runtime/js.cmi runtime/js.cmj -o runtime/caml_array.cmj : cc_cmi runtime/caml_array.ml | runtime/caml_array.cmi runtime/caml_array_extern.cmj -o runtime/caml_array.cmi : cc runtime/caml_array.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_bytes.cmj : cc_cmi runtime/caml_bytes.ml | runtime/caml_bytes.cmi -o runtime/caml_bytes.cmi : cc runtime/caml_bytes.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_float.cmj : cc_cmi runtime/caml_float.ml | runtime/caml_float.cmi runtime/caml_float_extern.cmj -o runtime/caml_float.cmi : cc runtime/caml_float.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml.cmj : cc_cmi runtime/caml.res | runtime/caml.cmi runtime/caml_int64_extern.cmj +o runtime/caml.cmi : cc runtime/caml.resi | runtime/bs_stdlib_mini.cmi runtime/caml_int64_extern.cmj runtime/js.cmi runtime/js.cmj +o runtime/caml_array.cmj : cc_cmi runtime/caml_array.res | runtime/caml_array.cmi runtime/caml_array_extern.cmj +o runtime/caml_array.cmi : cc runtime/caml_array.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_bytes.cmj : cc_cmi runtime/caml_bytes.res | runtime/caml_bytes.cmi +o runtime/caml_bytes.cmi : cc runtime/caml_bytes.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_float.cmj : cc_cmi runtime/caml_float.res | runtime/caml_float.cmi runtime/caml_float_extern.cmj +o runtime/caml_float.cmi : cc runtime/caml_float.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj o runtime/caml_format.cmj : cc_cmi runtime/caml_format.ml | runtime/caml.cmj runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_format.cmi runtime/caml_int64.cmj runtime/caml_int64_extern.cmj runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj o runtime/caml_format.cmi : cc runtime/caml_format.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_hash.cmj : cc_cmi runtime/caml_hash.ml | runtime/caml_hash.cmi runtime/caml_hash_primitive.cmj runtime/caml_nativeint_extern.cmj runtime/js.cmj -o runtime/caml_hash.cmi : cc runtime/caml_hash.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_hash_primitive.cmj : cc_cmi runtime/caml_hash_primitive.ml | runtime/caml_hash_primitive.cmi runtime/caml_string_extern.cmj -o runtime/caml_hash_primitive.cmi : cc runtime/caml_hash_primitive.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_int32.cmj : cc_cmi runtime/caml_int32.ml | runtime/caml_int32.cmi runtime/caml_nativeint_extern.cmj -o runtime/caml_int32.cmi : cc runtime/caml_int32.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_int64.cmj : cc_cmi runtime/caml_int64.ml | runtime/caml.cmj runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_int64.cmi runtime/caml_int64_extern.cmj runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj runtime/js.cmj -o runtime/caml_int64.cmi : cc runtime/caml_int64.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_lexer.cmj : cc_cmi runtime/caml_lexer.ml | runtime/caml_lexer.cmi -o runtime/caml_lexer.cmi : cc runtime/caml_lexer.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_md5.cmj : cc_cmi runtime/caml_md5.ml | runtime/caml_array_extern.cmj runtime/caml_md5.cmi runtime/caml_string_extern.cmj -o runtime/caml_md5.cmi : cc runtime/caml_md5.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_module.cmj : cc_cmi runtime/caml_module.ml | runtime/caml_array_extern.cmj runtime/caml_module.cmi runtime/caml_obj.cmj -o runtime/caml_module.cmi : cc runtime/caml_module.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_hash.cmj : cc_cmi runtime/caml_hash.res | runtime/caml_hash.cmi runtime/caml_hash_primitive.cmj runtime/caml_nativeint_extern.cmj runtime/js.cmj +o runtime/caml_hash.cmi : cc runtime/caml_hash.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_hash_primitive.cmj : cc_cmi runtime/caml_hash_primitive.res | runtime/caml_hash_primitive.cmi runtime/caml_string_extern.cmj +o runtime/caml_hash_primitive.cmi : cc runtime/caml_hash_primitive.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_int32.cmj : cc_cmi runtime/caml_int32.res | runtime/caml_int32.cmi runtime/caml_nativeint_extern.cmj +o runtime/caml_int32.cmi : cc runtime/caml_int32.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_int64.cmj : cc_cmi runtime/caml_int64.res | runtime/caml.cmj runtime/caml_float.cmj runtime/caml_float_extern.cmj runtime/caml_int64.cmi runtime/caml_int64_extern.cmj runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmj runtime/js.cmj +o runtime/caml_int64.cmi : cc runtime/caml_int64.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_lexer.cmj : cc_cmi runtime/caml_lexer.res | runtime/caml_lexer.cmi +o runtime/caml_lexer.cmi : cc runtime/caml_lexer.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_md5.cmj : cc_cmi runtime/caml_md5.res | runtime/caml_array_extern.cmj runtime/caml_md5.cmi runtime/caml_string_extern.cmj +o runtime/caml_md5.cmi : cc runtime/caml_md5.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_module.cmj : cc_cmi runtime/caml_module.res | runtime/caml_array_extern.cmj runtime/caml_module.cmi runtime/caml_obj.cmj +o runtime/caml_module.cmi : cc runtime/caml_module.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj o runtime/caml_obj.cmj : cc_cmi runtime/caml_obj.res | runtime/caml.cmj runtime/caml_array_extern.cmj runtime/caml_obj.cmi runtime/caml_option.cmj runtime/js.cmj -o runtime/caml_obj.cmi : cc runtime/caml_obj.resi | runtime/js.cmj -o runtime/caml_option.cmj : cc_cmi runtime/caml_option.ml | runtime/caml_option.cmi runtime/caml_undefined_extern.cmj runtime/js.cmj -o runtime/caml_option.cmi : cc runtime/caml_option.mli | runtime/bs_stdlib_mini.cmi runtime/caml_undefined_extern.cmj runtime/js.cmi runtime/js.cmj -o runtime/caml_parser.cmj : cc_cmi runtime/caml_parser.ml | runtime/caml_parser.cmi -o runtime/caml_parser.cmi : cc runtime/caml_parser.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_splice_call.cmj : cc_cmi runtime/caml_splice_call.ml | runtime/caml_splice_call.cmi -o runtime/caml_splice_call.cmi : cc runtime/caml_splice_call.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_string.cmj : cc_cmi runtime/caml_string.ml | runtime/caml_string.cmi runtime/caml_string_extern.cmj -o runtime/caml_string.cmi : cc runtime/caml_string.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_sys.cmj : cc_cmi runtime/caml_sys.ml | runtime/caml_array_extern.cmj runtime/caml_sys.cmi runtime/caml_undefined_extern.cmj runtime/js.cmj -o runtime/caml_sys.cmi : cc runtime/caml_sys.mli | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_array_extern.cmi runtime/caml_array_extern.cmj : cc runtime/caml_array_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj : cc runtime/caml_exceptions.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_external_polyfill.cmi runtime/caml_external_polyfill.cmj : cc runtime/caml_external_polyfill.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_float_extern.cmi runtime/caml_float_extern.cmj : cc runtime/caml_float_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_int64_extern.cmi runtime/caml_int64_extern.cmj : cc runtime/caml_int64_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj : cc runtime/caml_js_exceptions.ml | runtime/bs_stdlib_mini.cmi runtime/caml_exceptions.cmj runtime/caml_option.cmj runtime/js.cmi runtime/js.cmj -o runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj : cc runtime/caml_nativeint_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_string_extern.cmi runtime/caml_string_extern.cmj : cc runtime/caml_string_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/caml_undefined_extern.cmi runtime/caml_undefined_extern.cmj : cc runtime/caml_undefined_extern.ml | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj -o runtime/curry.cmi runtime/curry.cmj : cc runtime/curry.ml | runtime/bs_stdlib_mini.cmi runtime/caml_array.cmj runtime/caml_array_extern.cmj runtime/js.cmi runtime/js.cmj +o runtime/caml_obj.cmi : cc runtime/caml_obj.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_option.cmj : cc_cmi runtime/caml_option.res | runtime/caml_option.cmi runtime/caml_undefined_extern.cmj runtime/js.cmj +o runtime/caml_option.cmi : cc runtime/caml_option.resi | runtime/bs_stdlib_mini.cmi runtime/caml_undefined_extern.cmj runtime/js.cmi runtime/js.cmj +o runtime/caml_parser.cmj : cc_cmi runtime/caml_parser.res | runtime/caml_parser.cmi +o runtime/caml_parser.cmi : cc runtime/caml_parser.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_splice_call.cmj : cc_cmi runtime/caml_splice_call.res | runtime/caml_splice_call.cmi +o runtime/caml_splice_call.cmi : cc runtime/caml_splice_call.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_string.cmj : cc_cmi runtime/caml_string.res | runtime/caml_string.cmi runtime/caml_string_extern.cmj +o runtime/caml_string.cmi : cc runtime/caml_string.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_sys.cmj : cc_cmi runtime/caml_sys.res | runtime/caml_array_extern.cmj runtime/caml_sys.cmi runtime/caml_undefined_extern.cmj runtime/js.cmj +o runtime/caml_sys.cmi : cc runtime/caml_sys.resi | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_array_extern.cmi runtime/caml_array_extern.cmj : cc runtime/caml_array_extern.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj : cc runtime/caml_exceptions.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_external_polyfill.cmi runtime/caml_external_polyfill.cmj : cc runtime/caml_external_polyfill.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_float_extern.cmi runtime/caml_float_extern.cmj : cc runtime/caml_float_extern.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_int64_extern.cmi runtime/caml_int64_extern.cmj : cc runtime/caml_int64_extern.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj : cc runtime/caml_js_exceptions.res | runtime/bs_stdlib_mini.cmi runtime/caml_exceptions.cmj runtime/caml_option.cmj runtime/js.cmi runtime/js.cmj +o runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj : cc runtime/caml_nativeint_extern.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_string_extern.cmi runtime/caml_string_extern.cmj : cc runtime/caml_string_extern.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/caml_undefined_extern.cmi runtime/caml_undefined_extern.cmj : cc runtime/caml_undefined_extern.res | runtime/bs_stdlib_mini.cmi runtime/js.cmi runtime/js.cmj +o runtime/curry.cmi runtime/curry.cmj : cc runtime/curry.res | runtime/bs_stdlib_mini.cmi runtime/caml_array.cmj runtime/caml_array_extern.cmj runtime/js.cmi runtime/js.cmj o runtime : phony runtime/bs_stdlib_mini.cmi runtime/js.cmj runtime/js.cmi runtime/caml.cmi runtime/caml.cmj runtime/caml_array.cmi runtime/caml_array.cmj runtime/caml_bytes.cmi runtime/caml_bytes.cmj runtime/caml_float.cmi runtime/caml_float.cmj runtime/caml_format.cmi runtime/caml_format.cmj runtime/caml_hash.cmi runtime/caml_hash.cmj runtime/caml_hash_primitive.cmi runtime/caml_hash_primitive.cmj runtime/caml_int32.cmi runtime/caml_int32.cmj runtime/caml_int64.cmi runtime/caml_int64.cmj runtime/caml_lexer.cmi runtime/caml_lexer.cmj runtime/caml_md5.cmi runtime/caml_md5.cmj runtime/caml_module.cmi runtime/caml_module.cmj runtime/caml_obj.cmi runtime/caml_obj.cmj runtime/caml_option.cmi runtime/caml_option.cmj runtime/caml_parser.cmi runtime/caml_parser.cmj runtime/caml_splice_call.cmi runtime/caml_splice_call.cmj runtime/caml_string.cmi runtime/caml_string.cmj runtime/caml_sys.cmi runtime/caml_sys.cmj runtime/caml_array_extern.cmi runtime/caml_array_extern.cmj runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj runtime/caml_external_polyfill.cmi runtime/caml_external_polyfill.cmj runtime/caml_float_extern.cmi runtime/caml_float_extern.cmj runtime/caml_int64_extern.cmi runtime/caml_int64_extern.cmj runtime/caml_js_exceptions.cmi runtime/caml_js_exceptions.cmj runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj runtime/caml_string_extern.cmi runtime/caml_string_extern.cmj runtime/caml_undefined_extern.cmi runtime/caml_undefined_extern.cmj runtime/curry.cmi runtime/curry.cmj diff --git a/lib/es6/caml_external_polyfill.js b/lib/es6/caml_external_polyfill.js index b81bffc455..818c834009 100644 --- a/lib/es6/caml_external_polyfill.js +++ b/lib/es6/caml_external_polyfill.js @@ -7,7 +7,7 @@ var getGlobalThis = (function(){ if (typeof window !== 'undefined') return window; if (typeof global !== 'undefined') return global; if (typeof this !== 'undefined') return this; - throw new Error('Unable to locate global `this`'); + throw new Error('Unable to locate global this'); }); var resolve = (function(s){ diff --git a/lib/es6/caml_int64.js b/lib/es6/caml_int64.js index bd2647a17e..220d8eb25d 100644 --- a/lib/es6/caml_int64.js +++ b/lib/es6/caml_int64.js @@ -182,11 +182,11 @@ function asr_(x, numBits) { } } -function is_zero(param) { - if (param[0] !== 0) { +function is_zero(x) { + if (x[0] !== 0) { return false; } else { - return param[1] === 0; + return x[1] === 0; } } diff --git a/lib/es6/caml_module.js b/lib/es6/caml_module.js index d7bbd0121d..5ec8926a27 100644 --- a/lib/es6/caml_module.js +++ b/lib/es6/caml_module.js @@ -83,9 +83,9 @@ function update_mod(shape, o, n) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "caml_module.ml", - 107, - 10 + "caml_module.res", + 109, + 9 ], Error: new Error() }; @@ -102,9 +102,9 @@ function update_mod(shape, o, n) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "caml_module.ml", - 107, - 10 + "caml_module.res", + 109, + 9 ], Error: new Error() }; diff --git a/lib/es6/caml_splice_call.js b/lib/es6/caml_splice_call.js index c78e11fb97..fdc44ff6cb 100644 --- a/lib/es6/caml_splice_call.js +++ b/lib/es6/caml_splice_call.js @@ -18,7 +18,7 @@ var spliceApply = (function(fn,args){ var spliceNewApply = (function (ctor,args){ var i, argLen; argLen = args.length - var applied = [null] // Function.prototype.bind.apply(fn, args) requires the first element in `args` to be `null` + var applied = [null] // Function.prototype.bind.apply(fn, args) requires the first element in \`args\` to be \`null\` for(i = 0; i < argLen - 1; ++i){ applied.push(args[i]) } diff --git a/lib/js/caml_external_polyfill.js b/lib/js/caml_external_polyfill.js index a4b0853d78..5004ae1ba5 100644 --- a/lib/js/caml_external_polyfill.js +++ b/lib/js/caml_external_polyfill.js @@ -7,7 +7,7 @@ var getGlobalThis = (function(){ if (typeof window !== 'undefined') return window; if (typeof global !== 'undefined') return global; if (typeof this !== 'undefined') return this; - throw new Error('Unable to locate global `this`'); + throw new Error('Unable to locate global this'); }); var resolve = (function(s){ diff --git a/lib/js/caml_int64.js b/lib/js/caml_int64.js index d3c8873934..5a69f07ca0 100644 --- a/lib/js/caml_int64.js +++ b/lib/js/caml_int64.js @@ -182,11 +182,11 @@ function asr_(x, numBits) { } } -function is_zero(param) { - if (param[0] !== 0) { +function is_zero(x) { + if (x[0] !== 0) { return false; } else { - return param[1] === 0; + return x[1] === 0; } } diff --git a/lib/js/caml_module.js b/lib/js/caml_module.js index 91585755a4..aec2274939 100644 --- a/lib/js/caml_module.js +++ b/lib/js/caml_module.js @@ -83,9 +83,9 @@ function update_mod(shape, o, n) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "caml_module.ml", - 107, - 10 + "caml_module.res", + 109, + 9 ], Error: new Error() }; @@ -102,9 +102,9 @@ function update_mod(shape, o, n) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "caml_module.ml", - 107, - 10 + "caml_module.res", + 109, + 9 ], Error: new Error() }; diff --git a/lib/js/caml_splice_call.js b/lib/js/caml_splice_call.js index 80a7afff44..30777062ad 100644 --- a/lib/js/caml_splice_call.js +++ b/lib/js/caml_splice_call.js @@ -18,7 +18,7 @@ var spliceApply = (function(fn,args){ var spliceNewApply = (function (ctor,args){ var i, argLen; argLen = args.length - var applied = [null] // Function.prototype.bind.apply(fn, args) requires the first element in `args` to be `null` + var applied = [null] // Function.prototype.bind.apply(fn, args) requires the first element in \`args\` to be \`null\` for(i = 0; i < argLen - 1; ++i){ applied.push(args[i]) } diff --git a/scripts/ninja.js b/scripts/ninja.js index 3af5a6ce84..4cf4e3b544 100755 --- a/scripts/ninja.js +++ b/scripts/ninja.js @@ -839,7 +839,7 @@ ${ruleCC(ninjaCwd)} ${ninjaQuickBuildList([ [ "bs_stdlib_mini.cmi", - "bs_stdlib_mini.mli", + "bs_stdlib_mini.resi", "cc", ninjaCwd, [["bsc_flags", "-nostdlib -nopervasives"]], @@ -868,9 +868,12 @@ ${ninjaQuickBuildList([ switch (ext) { case "HAS_MLI": case "HAS_BOTH": + case "HAS_RESI": + case "HAS_BOTH_RES": updateDepsKVsByFile(mod + ".cmi", manualDeps, depsMap); break; case "HAS_ML": + case "HAS_RES": updateDepsKVsByFile(mod + ".cmj", manualDeps, depsMap); break; }