diff --git a/jscomp/core/lam_dispatch_primitive.ml b/jscomp/core/lam_dispatch_primitive.ml index a942698120..a3097f2776 100644 --- a/jscomp/core/lam_dispatch_primitive.ml +++ b/jscomp/core/lam_dispatch_primitive.ml @@ -220,7 +220,6 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression also now we need do nullary check *) match args with [ e ] -> E.tag e | _ -> assert false) - | "?md5_string" -> call Js_runtime_modules.md5 | "?hash_mix_string" | "?hash_mix_int" | "?hash_final_mix" -> call Js_runtime_modules.hash_primitive | "?hash" -> call Js_runtime_modules.hash diff --git a/jscomp/ext/js_runtime_modules.ml b/jscomp/ext/js_runtime_modules.ml index 1b4ee1e8ee..ac4d7521ae 100644 --- a/jscomp/ext/js_runtime_modules.ml +++ b/jscomp/ext/js_runtime_modules.ml @@ -45,8 +45,6 @@ let caml_primitive = "Caml" let int64 = "Caml_int64" -let md5 = "Caml_md5" - let int32 = "Caml_int32" let bigint = "Caml_bigint" diff --git a/jscomp/runtime/caml_md5.res b/jscomp/runtime/caml_md5.res deleted file mode 100644 index b6b22d6205..0000000000 --- a/jscomp/runtime/caml_md5.res +++ /dev/null @@ -1,201 +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 => 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_md5.resi b/jscomp/runtime/caml_md5.resi deleted file mode 100644 index c7bb429ff5..0000000000 --- a/jscomp/runtime/caml_md5.resi +++ /dev/null @@ -1,25 +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 md5_string: (string, int, int) => string diff --git a/jscomp/runtime/release.ninja b/jscomp/runtime/release.ninja index fd30782907..97b01db6b0 100644 --- a/jscomp/runtime/release.ninja +++ b/jscomp/runtime/release.ninja @@ -33,8 +33,6 @@ o runtime/caml_int32.cmj : cc_cmi runtime/caml_int32.res | runtime/caml_int32.cm 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 o runtime/caml_int64.cmi : cc runtime/caml_int64.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 @@ -54,4 +52,4 @@ o runtime/caml_nativeint_extern.cmi runtime/caml_nativeint_extern.cmj : cc runti 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_bigint.cmi runtime/caml_bigint.cmj runtime/caml_bytes.cmi runtime/caml_bytes.cmj runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj runtime/caml_float.cmi runtime/caml_float.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_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_splice_call.cmi runtime/caml_splice_call.cmj runtime/caml_string.cmi runtime/caml_string.cmj runtime/caml_array_extern.cmi runtime/caml_array_extern.cmj runtime/caml_bigint_extern.cmi runtime/caml_bigint_extern.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 +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_bigint.cmi runtime/caml_bigint.cmj runtime/caml_bytes.cmi runtime/caml_bytes.cmj runtime/caml_exceptions.cmi runtime/caml_exceptions.cmj runtime/caml_float.cmi runtime/caml_float.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_module.cmi runtime/caml_module.cmj runtime/caml_obj.cmi runtime/caml_obj.cmj runtime/caml_option.cmi runtime/caml_option.cmj runtime/caml_splice_call.cmi runtime/caml_splice_call.cmj runtime/caml_string.cmi runtime/caml_string.cmj runtime/caml_array_extern.cmi runtime/caml_array_extern.cmj runtime/caml_bigint_extern.cmi runtime/caml_bigint_extern.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/jscomp/stdlib-406/digest.res b/jscomp/stdlib-406/digest.res deleted file mode 100644 index d922290395..0000000000 --- a/jscomp/stdlib-406/digest.res +++ /dev/null @@ -1,78 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/* Message digest (MD5) */ - -type t = string - -let compare = String.compare -let equal = String.equal - -external unsafe_string: (string, int, int) => t = "?md5_string" - -let string = str => unsafe_string(str, 0, String.length(str)) - -let bytes = b => string(Bytes.unsafe_to_string(b)) - -let substring = (str, ofs, len) => - if ofs < 0 || (len < 0 || ofs > String.length(str) - len) { - invalid_arg("Digest.substring") - } else { - unsafe_string(str, ofs, len) - } - -let subbytes = (b, ofs, len) => substring(Bytes.unsafe_to_string(b), ofs, len) - -let char_hex = n => - Char.unsafe_chr( - n + if n < 10 { - Char.code('0') - } else { - Char.code('a') - 10 - }, - ) - -let to_hex = d => { - if String.length(d) != 16 { - invalid_arg("Digest.to_hex") - } - let result = Bytes.create(32) - for i in 0 to 15 { - let x = Char.code(String.get(d, i)) - Bytes.unsafe_set(result, i * 2, char_hex(lsr(x, 4))) - Bytes.unsafe_set(result, i * 2 + 1, char_hex(land(x, 0x0f))) - } - Bytes.unsafe_to_string(result) -} - -let from_hex = s => { - if String.length(s) != 32 { - invalid_arg("Digest.from_hex") - } - let digit = c => - switch c { - | '0' .. '9' => Char.code(c) - Char.code('0') - | 'A' .. 'F' => Char.code(c) - Char.code('A') + 10 - | 'a' .. 'f' => Char.code(c) - Char.code('a') + 10 - | _ => raise(Invalid_argument("Digest.from_hex")) - } - - let byte = i => lsl(digit(String.get(s, i)), 4) + digit(String.get(s, i + 1)) - let result = Bytes.create(16) - for i in 0 to 15 { - Bytes.set(result, i, Char.chr(byte(2 * i))) - } - Bytes.unsafe_to_string(result) -} diff --git a/jscomp/stdlib-406/digest.resi b/jscomp/stdlib-406/digest.resi deleted file mode 100644 index bcedb527e5..0000000000 --- a/jscomp/stdlib-406/digest.resi +++ /dev/null @@ -1,67 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/*** MD5 message digest. - - This module provides functions to compute 128-bit 'digests' of - arbitrary-length strings or files. The digests are of cryptographic - quality: it is very hard, given a digest, to forge a string having - that digest. The algorithm used is MD5. This module should not be - used for secure and sensitive cryptographic applications. For these - kind of applications more recent and stronger cryptographic - primitives should be used instead. -*/ - -/** The type of digests: 16-character strings. */ -type t = string - -/** The comparison function for 16-character digest, with the same - specification as {!Pervasives.compare} and the implementation - shared with {!String.compare}. Along with the type [t], this - function [compare] allows the module [Digest] to be passed as - argument to the functors {!Set.Make} and {!Map.Make}. - @since 4.00.0 */ -let compare: (t, t) => int - -/** The equal function for 16-character digest. - @since 4.03.0 */ -let equal: (t, t) => bool - -/** Return the digest of the given string. */ -let string: string => t - -/** Return the digest of the given byte sequence. - @since 4.02.0 */ -let bytes: bytes => t - -/** [Digest.substring s ofs len] returns the digest of the substring - of [s] starting at index [ofs] and containing [len] characters. */ -let substring: (string, int, int) => t - -/** [Digest.subbytes s ofs len] returns the digest of the subsequence - of [s] starting at index [ofs] and containing [len] bytes. - @since 4.02.0 */ -let subbytes: (bytes, int, int) => t - -/** Return the printable hexadecimal representation of the given digest. - Raise [Invalid_argument] if the argument is not exactly 16 bytes. - */ -let to_hex: t => string - -/** Convert a hexadecimal representation back into the corresponding digest. - Raise [Invalid_argument] if the argument is not exactly 32 hexadecimal - characters. - @since 4.00.0 */ -let from_hex: string => t diff --git a/jscomp/stdlib-406/hashtbl.res b/jscomp/stdlib-406/hashtbl.res deleted file mode 100644 index 58c3ac9735..0000000000 --- a/jscomp/stdlib-406/hashtbl.res +++ /dev/null @@ -1,679 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/* Hash tables */ - -@noalloc external seeded_hash_param: (int, int, int, 'a) => int = "?hash" -/* external old_hash_param : - int -> int -> 'a -> int = "caml_hash_univ_param" [@@noalloc] */ - -let hash = x => seeded_hash_param(10, 100, 0, x) -let hash_param = (n1, n2, x) => seeded_hash_param(n1, n2, 0, x) -let seeded_hash = (seed, x) => seeded_hash_param(10, 100, seed, x) - -/* We do dynamic hashing, and resize the table and rehash the elements - when buckets become too long. */ - -type rec t<'a, 'b> = { - mutable size: int /* number of entries */, - mutable data: array> /* the buckets */, - mutable seed: int /* for randomization */, - mutable initial_size: int /* initial array size */, -} - -and bucketlist<'a, 'b> = - | Empty - | Cons({mutable key: 'a, mutable data: 'b, mutable next: bucketlist<'a, 'b>}) - -/* The sign of initial_size encodes the fact that a traversal is - ongoing or not. - - This disables the efficient in place implementation of resizing. -*/ - -let ongoing_traversal = h => h.initial_size < 0 - -let flip_ongoing_traversal = h => h.initial_size = -h.initial_size - -/* To pick random seeds if requested */ - -let randomized_default = false - -let randomized = ref(randomized_default) - -let randomize = () => randomized := true -let is_randomized = () => randomized.contents - -let prng = Lazy.from_fun(() => Random.State.make_self_init()) - -/* Creating a fresh, empty table */ - -let rec power_2_above = (x, n) => - if x >= n { - x - } else if x * 2 < x { - x /* overflow */ - } else { - power_2_above(x * 2, n) - } - -let create = (~random=randomized.contents, initial_size) => { - let s = power_2_above(16, initial_size) - let seed = if random { - Random.State.bits(Lazy.force(prng)) - } else { - 0 - } - {initial_size: s, size: 0, seed, data: Array.make(s, Empty)} -} - -let clear = h => { - h.size = 0 - let len = Array.length(h.data) - for i in 0 to len - 1 { - h.data[i] = Empty - } -} - -let reset = h => { - let len = Array.length(h.data) - if len == abs(h.initial_size) { - clear(h) - } else { - h.size = 0 - h.data = Array.make(abs(h.initial_size), Empty) - } -} - -let copy_bucketlist = param => - switch param { - | Empty => Empty - | Cons({key, data, next}) => - let rec loop = (prec, param) => - switch param { - | Empty => () - | Cons({key, data, next}) => - let r = Cons({key, data, next}) - switch prec { - | Empty => assert(false) - | Cons(prec) => prec.next = r - } - loop(r, next) - } - - let r = Cons({key, data, next}) - loop(r, next) - r - } - -let copy = h => {...h, data: Array.map(copy_bucketlist, h.data)} - -let length = h => h.size - -let resize = (indexfun, h) => { - let odata = h.data - let osize = Array.length(odata) - let nsize = osize * 2 - if nsize >= osize { - let ndata = Array.make(nsize, Empty) - let ndata_tail = Array.make(nsize, Empty) - let inplace = !ongoing_traversal(h) - h.data = ndata /* so that indexfun sees the new bucket count */ - let rec insert_bucket = param => - switch param { - | Empty => () - | Cons({key, data, next}) as cell => - let cell = if inplace { - cell - } else { - Cons({key, data, next: Empty}) - } - - let nidx = indexfun(h, key) - switch ndata_tail[nidx] { - | Empty => ndata[nidx] = cell - | Cons(tail) => tail.next = cell - } - ndata_tail[nidx] = cell - insert_bucket(next) - } - - for i in 0 to osize - 1 { - insert_bucket(odata[i]) - } - if inplace { - for i in 0 to nsize - 1 { - switch ndata_tail[i] { - | Empty => () - | Cons(tail) => tail.next = Empty - } - } - } - } -} - -let key_index = (h, key) => - /* compatibility with old hash tables */ - land(seeded_hash_param(10, 100, h.seed, key), Array.length(h.data) - 1) - -let add = (h, key, data) => { - let i = key_index(h, key) - let bucket = Cons({key, data, next: h.data[i]}) - h.data[i] = bucket - h.size = h.size + 1 - if h.size > lsl(Array.length(h.data), 1) { - resize(key_index, h) - } -} - -let rec remove_bucket = (h, i, key, prec, param) => - switch param { - | Empty => () - | Cons({key: k, next}) as c => - if compare(k, key) == 0 { - h.size = h.size - 1 - switch prec { - | Empty => h.data[i] = next - | Cons(c) => c.next = next - } - } else { - remove_bucket(h, i, key, c, next) - } - } - -let remove = (h, key) => { - let i = key_index(h, key) - remove_bucket(h, i, key, Empty, h.data[i]) -} - -let rec find_rec = (key, param) => - switch param { - | Empty => raise(Not_found) - | Cons({key: k, data, next}) => - if compare(key, k) == 0 { - data - } else { - find_rec(key, next) - } - } - -let find = (h, key) => - switch h.data[key_index(h, key)] { - | Empty => raise(Not_found) - | Cons({key: k1, data: d1, next: next1}) => - if compare(key, k1) == 0 { - d1 - } else { - switch next1 { - | Empty => raise(Not_found) - | Cons({key: k2, data: d2, next: next2}) => - if compare(key, k2) == 0 { - d2 - } else { - switch next2 { - | Empty => raise(Not_found) - | Cons({key: k3, data: d3, next: next3}) => - if compare(key, k3) == 0 { - d3 - } else { - find_rec(key, next3) - } - } - } - } - } - } - -let rec find_rec_opt = (key, param) => - switch param { - | Empty => None - | Cons({key: k, data, next}) => - if compare(key, k) == 0 { - Some(data) - } else { - find_rec_opt(key, next) - } - } - -let find_opt = (h, key) => - switch h.data[key_index(h, key)] { - | Empty => None - | Cons({key: k1, data: d1, next: next1}) => - if compare(key, k1) == 0 { - Some(d1) - } else { - switch next1 { - | Empty => None - | Cons({key: k2, data: d2, next: next2}) => - if compare(key, k2) == 0 { - Some(d2) - } else { - switch next2 { - | Empty => None - | Cons({key: k3, data: d3, next: next3}) => - if compare(key, k3) == 0 { - Some(d3) - } else { - find_rec_opt(key, next3) - } - } - } - } - } - } - -let find_all = (h, key) => { - let rec find_in_bucket = param => - switch param { - | Empty => list{} - | Cons({key: k, data, next}) => - if compare(k, key) == 0 { - list{data, ...find_in_bucket(next)} - } else { - find_in_bucket(next) - } - } - find_in_bucket(h.data[key_index(h, key)]) -} - -let rec replace_bucket = (key, data, param) => - switch param { - | Empty => true - | Cons({key: k, next} as slot) => - if compare(k, key) == 0 { - slot.key = key - slot.data = data - false - } else { - replace_bucket(key, data, next) - } - } - -let replace = (h, key, data) => { - let i = key_index(h, key) - let l = h.data[i] - if replace_bucket(key, data, l) { - h.data[i] = Cons({key, data, next: l}) - h.size = h.size + 1 - if h.size > lsl(Array.length(h.data), 1) { - resize(key_index, h) - } - } -} - -let mem = (h, key) => { - let rec mem_in_bucket = param => - switch param { - | Empty => false - | Cons({key: k, next}) => compare(k, key) == 0 || mem_in_bucket(next) - } - mem_in_bucket(h.data[key_index(h, key)]) -} - -let iter = (f, h) => { - let rec do_bucket = param => - switch param { - | Empty => () - | Cons({key, data, next}) => - f(key, data) - do_bucket(next) - } - let old_trav = ongoing_traversal(h) - if !old_trav { - flip_ongoing_traversal(h) - } - try { - let d = h.data - for i in 0 to Array.length(d) - 1 { - do_bucket(d[i]) - } - if !old_trav { - flip_ongoing_traversal(h) - } - } catch { - | exn if !old_trav => - flip_ongoing_traversal(h) - raise(exn) - } -} - -let rec filter_map_inplace_bucket = (f, h, i, prec, param) => - switch param { - | Empty => - switch prec { - | Empty => h.data[i] = Empty - | Cons(c) => c.next = Empty - } - | Cons({key, data, next} as c) as slot => - switch f(key, data) { - | None => - h.size = h.size - 1 - filter_map_inplace_bucket(f, h, i, prec, next) - | Some(data) => - switch prec { - | Empty => h.data[i] = slot - | Cons(c) => c.next = slot - } - c.data = data - filter_map_inplace_bucket(f, h, i, slot, next) - } - } - -let filter_map_inplace = (f, h) => { - let d = h.data - let old_trav = ongoing_traversal(h) - if !old_trav { - flip_ongoing_traversal(h) - } - try for i in 0 to Array.length(d) - 1 { - filter_map_inplace_bucket(f, h, i, Empty, h.data[i]) - } catch { - | exn if !old_trav => - flip_ongoing_traversal(h) - raise(exn) - } -} - -let fold = (f, h, init) => { - let rec do_bucket = (b, accu) => - switch b { - | Empty => accu - | Cons({key, data, next}) => do_bucket(next, f(key, data, accu)) - } - let old_trav = ongoing_traversal(h) - if !old_trav { - flip_ongoing_traversal(h) - } - try { - let d = h.data - let accu = ref(init) - for i in 0 to Array.length(d) - 1 { - accu := do_bucket(d[i], accu.contents) - } - if !old_trav { - flip_ongoing_traversal(h) - } - accu.contents - } catch { - | exn if !old_trav => - flip_ongoing_traversal(h) - raise(exn) - } -} - -type statistics = { - num_bindings: int, - num_buckets: int, - max_bucket_length: int, - bucket_histogram: array, -} - -let rec bucket_length = (accu, param) => - switch param { - | Empty => accu - | Cons({next}) => bucket_length(accu + 1, next) - } - -let stats = h => { - let mbl = Array.fold_left((m, b) => max(m, bucket_length(0, b)), 0, h.data) - let histo = Array.make(mbl + 1, 0) - Array.iter(b => { - let l = bucket_length(0, b) - histo[l] = histo[l] + 1 - }, h.data) - { - num_bindings: h.size, - num_buckets: Array.length(h.data), - max_bucket_length: mbl, - bucket_histogram: histo, - } -} - -/* Functorial interface */ - -module type HashedType = { - type t - let equal: (t, t) => bool - let hash: t => int -} - -module type SeededHashedType = { - type t - let equal: (t, t) => bool - let hash: (int, t) => int -} - -module type S = { - type key - type t<'a> - let create: int => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, key, 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - let find_opt: (t<'a>, key) => option<'a> - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, key, 'a) => unit - let mem: (t<'a>, key) => bool - let iter: ((key, 'a) => unit, t<'a>) => unit - let filter_map_inplace: ((key, 'a) => option<'a>, t<'a>) => unit - let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics -} - -module type SeededS = { - type key - type t<'a> - let create: (~random: bool=?, int) => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, key, 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - let find_opt: (t<'a>, key) => option<'a> - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, key, 'a) => unit - let mem: (t<'a>, key) => bool - let iter: ((key, 'a) => unit, t<'a>) => unit - let filter_map_inplace: ((key, 'a) => option<'a>, t<'a>) => unit - let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics -} - -module MakeSeeded = (H: SeededHashedType): (SeededS with type key = H.t) => { - type key = H.t - type hashtbl<'a> = t - type t<'a> = hashtbl<'a> - let create = create - let clear = clear - let reset = reset - let copy = copy - - let key_index = (h, key) => land(H.hash(h.seed, key), Array.length(h.data) - 1) - - let add = (h, key, data) => { - let i = key_index(h, key) - let bucket = Cons({key, data, next: h.data[i]}) - h.data[i] = bucket - h.size = h.size + 1 - if h.size > lsl(Array.length(h.data), 1) { - resize(key_index, h) - } - } - - let rec remove_bucket = (h, i, key, prec, param) => - switch param { - | Empty => () - | Cons({key: k, next}) as c => - if H.equal(k, key) { - h.size = h.size - 1 - switch prec { - | Empty => h.data[i] = next - | Cons(c) => c.next = next - } - } else { - remove_bucket(h, i, key, c, next) - } - } - - let remove = (h, key) => { - let i = key_index(h, key) - remove_bucket(h, i, key, Empty, h.data[i]) - } - - let rec find_rec = (key, param) => - switch param { - | Empty => raise(Not_found) - | Cons({key: k, data, next}) => - if H.equal(key, k) { - data - } else { - find_rec(key, next) - } - } - - let find = (h, key) => - switch h.data[key_index(h, key)] { - | Empty => raise(Not_found) - | Cons({key: k1, data: d1, next: next1}) => - if H.equal(key, k1) { - d1 - } else { - switch next1 { - | Empty => raise(Not_found) - | Cons({key: k2, data: d2, next: next2}) => - if H.equal(key, k2) { - d2 - } else { - switch next2 { - | Empty => raise(Not_found) - | Cons({key: k3, data: d3, next: next3}) => - if H.equal(key, k3) { - d3 - } else { - find_rec(key, next3) - } - } - } - } - } - } - - let rec find_rec_opt = (key, param) => - switch param { - | Empty => None - | Cons({key: k, data, next}) => - if H.equal(key, k) { - Some(data) - } else { - find_rec_opt(key, next) - } - } - - let find_opt = (h, key) => - switch h.data[key_index(h, key)] { - | Empty => None - | Cons({key: k1, data: d1, next: next1}) => - if H.equal(key, k1) { - Some(d1) - } else { - switch next1 { - | Empty => None - | Cons({key: k2, data: d2, next: next2}) => - if H.equal(key, k2) { - Some(d2) - } else { - switch next2 { - | Empty => None - | Cons({key: k3, data: d3, next: next3}) => - if H.equal(key, k3) { - Some(d3) - } else { - find_rec_opt(key, next3) - } - } - } - } - } - } - - let find_all = (h, key) => { - let rec find_in_bucket = param => - switch param { - | Empty => list{} - | Cons({key: k, data: d, next}) => - if H.equal(k, key) { - list{d, ...find_in_bucket(next)} - } else { - find_in_bucket(next) - } - } - find_in_bucket(h.data[key_index(h, key)]) - } - - let rec replace_bucket = (key, data, param) => - switch param { - | Empty => true - | Cons({key: k, next} as slot) => - if H.equal(k, key) { - slot.key = key - slot.data = data - false - } else { - replace_bucket(key, data, next) - } - } - - let replace = (h, key, data) => { - let i = key_index(h, key) - let l = h.data[i] - if replace_bucket(key, data, l) { - h.data[i] = Cons({key, data, next: l}) - h.size = h.size + 1 - if h.size > lsl(Array.length(h.data), 1) { - resize(key_index, h) - } - } - } - - let mem = (h, key) => { - let rec mem_in_bucket = param => - switch param { - | Empty => false - | Cons({key: k, next}) => H.equal(k, key) || mem_in_bucket(next) - } - mem_in_bucket(h.data[key_index(h, key)]) - } - - let iter = iter - let filter_map_inplace = filter_map_inplace - let fold = fold - let length = length - let stats = stats -} - -module Make = (H: HashedType): (S with type key = H.t) => { - include MakeSeeded({ - type t = H.t - let equal = H.equal - let hash = (_seed: int, x) => H.hash(x) - }) - let create = sz => create(~random=false, sz) -} diff --git a/jscomp/stdlib-406/hashtbl.resi b/jscomp/stdlib-406/hashtbl.resi deleted file mode 100644 index 5acfde280f..0000000000 --- a/jscomp/stdlib-406/hashtbl.resi +++ /dev/null @@ -1,406 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/*** Hash tables and hash functions. - - Hash tables are hashed association tables, with in-place modification. -*/ - -/* {1 Generic interface} */ - -/** The type of hash tables from type ['a] to type ['b]. */ -type t<'a, 'b> - -/** [Hashtbl.create n] creates a new, empty hash table, with - initial size [n]. For best results, [n] should be on the - order of the expected number of elements that will be in - the table. The table grows as needed, so [n] is just an - initial guess. - - The optional [random] parameter (a boolean) controls whether - the internal organization of the hash table is randomized at each - execution of [Hashtbl.create] or deterministic over all executions. - - A hash table that is created with [~random:false] uses a - fixed hash function ({!Hashtbl.hash}) to distribute keys among - buckets. As a consequence, collisions between keys happen - deterministically. In Web-facing applications or other - security-sensitive applications, the deterministic collision - patterns can be exploited by a malicious user to create a - denial-of-service attack: the attacker sends input crafted to - create many collisions in the table, slowing the application down. - - A hash table that is created with [~random:true] uses the seeded - hash function {!Hashtbl.seeded_hash} with a seed that is randomly - chosen at hash table creation time. In effect, the hash function - used is randomly selected among [2^{30}] different hash functions. - All these hash functions have different collision patterns, - rendering ineffective the denial-of-service attack described above. - However, because of randomization, enumerating all elements of the - hash table using {!Hashtbl.fold} or {!Hashtbl.iter} is no longer - deterministic: elements are enumerated in different orders at - different runs of the program. - - If no [~random] parameter is given, hash tables are created - in non-random mode by default. This default can be changed - either programmatically by calling {!Hashtbl.randomize} or by - setting the [R] flag in the [OCAMLRUNPARAM] environment variable. - - @before 4.00.0 the [random] parameter was not present and all - hash tables were created in non-randomized mode. */ -let create: (~random: bool=?, int) => t<'a, 'b> - -/** Empty a hash table. Use [reset] instead of [clear] to shrink the - size of the bucket table to its initial size. */ -let clear: t<'a, 'b> => unit - -/** Empty a hash table and shrink the size of the bucket table - to its initial size. - @since 4.00.0 */ -let reset: t<'a, 'b> => unit - -/** Return a copy of the given hashtable. */ -let copy: t<'a, 'b> => t<'a, 'b> - -/** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. - Previous bindings for [x] are not removed, but simply - hidden. That is, after performing {!Hashtbl.remove}[ tbl x], - the previous binding for [x], if any, is restored. - (Same behavior as with association lists.) */ -let add: (t<'a, 'b>, 'a, 'b) => unit - -/** [Hashtbl.find tbl x] returns the current binding of [x] in [tbl], - or raises [Not_found] if no such binding exists. */ -let find: (t<'a, 'b>, 'a) => 'b - -/** [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl], - or [None] if no such binding exists. - @since 4.05 */ -let find_opt: (t<'a, 'b>, 'a) => option<'b> - -/** [Hashtbl.find_all tbl x] returns the list of all data - associated with [x] in [tbl]. - The current binding is returned first, then the previous - bindings, in reverse order of introduction in the table. */ -let find_all: (t<'a, 'b>, 'a) => list<'b> - -/** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. */ -let mem: (t<'a, 'b>, 'a) => bool - -/** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], - restoring the previous binding if it exists. - It does nothing if [x] is not bound in [tbl]. */ -let remove: (t<'a, 'b>, 'a) => unit - -/** [Hashtbl.replace tbl x y] replaces the current binding of [x] - in [tbl] by a binding of [x] to [y]. If [x] is unbound in [tbl], - a binding of [x] to [y] is added to [tbl]. - This is functionally equivalent to {!Hashtbl.remove}[ tbl x] - followed by {!Hashtbl.add}[ tbl x y]. */ -let replace: (t<'a, 'b>, 'a, 'b) => unit - -/** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. - [f] receives the key as first argument, and the associated value - as second argument. Each binding is presented exactly once to [f]. - - The order in which the bindings are passed to [f] is unspecified. - However, if the table contains several bindings for the same key, - they are passed to [f] in reverse order of introduction, that is, - the most recent binding is passed first. - - If the hash table was created in non-randomized mode, the order - in which the bindings are enumerated is reproducible between - successive runs of the program, and even between minor versions - of OCaml. For randomized hash tables, the order of enumeration - is entirely random. - - The behavior is not defined if the hash table is modified - by [f] during the iteration. -*/ -let iter: (('a, 'b) => unit, t<'a, 'b>) => unit - -/** [Hashtbl.filter_map_inplace f tbl] applies [f] to all bindings in - table [tbl] and update each binding depending on the result of - [f]. If [f] returns [None], the binding is discarded. If it - returns [Some new_val], the binding is update to associate the key - to [new_val]. - - Other comments for {!Hashtbl.iter} apply as well. - @since 4.03.0 */ -let filter_map_inplace: (('a, 'b) => option<'b>, t<'a, 'b>) => unit - -/** [Hashtbl.fold f tbl init] computes - [(f kN dN ... (f k1 d1 init)...)], - where [k1 ... kN] are the keys of all bindings in [tbl], - and [d1 ... dN] are the associated values. - Each binding is presented exactly once to [f]. - - The order in which the bindings are passed to [f] is unspecified. - However, if the table contains several bindings for the same key, - they are passed to [f] in reverse order of introduction, that is, - the most recent binding is passed first. - - If the hash table was created in non-randomized mode, the order - in which the bindings are enumerated is reproducible between - successive runs of the program, and even between minor versions - of OCaml. For randomized hash tables, the order of enumeration - is entirely random. - - The behavior is not defined if the hash table is modified - by [f] during the iteration. -*/ -let fold: (('a, 'b, 'c) => 'c, t<'a, 'b>, 'c) => 'c - -/** [Hashtbl.length tbl] returns the number of bindings in [tbl]. - It takes constant time. Multiple bindings are counted once each, so - [Hashtbl.length] gives the number of times [Hashtbl.iter] calls its - first argument. */ -let length: t<'a, 'b> => int - -/** After a call to [Hashtbl.randomize()], hash tables are created in - randomized mode by default: {!Hashtbl.create} returns randomized - hash tables, unless the [~random:false] optional parameter is given. - The same effect can be achieved by setting the [R] parameter in - the [OCAMLRUNPARAM] environment variable. - - It is recommended that applications or Web frameworks that need to - protect themselves against the denial-of-service attack described - in {!Hashtbl.create} call [Hashtbl.randomize()] at initialization - time. - - Note that once [Hashtbl.randomize()] was called, there is no way - to revert to the non-randomized default behavior of {!Hashtbl.create}. - This is intentional. Non-randomized hash tables can still be - created using [Hashtbl.create ~random:false]. - - @since 4.00.0 */ -let randomize: unit => unit - -/** return if the tables are currently created in randomized mode by default - - @since 4.03.0 */ -let is_randomized: unit => bool - -/** @since 4.00.0 */ -type statistics = { - /** Number of bindings present in the table. - Same value as returned by {!Hashtbl.length}. */ - num_bindings: int, - /** Number of buckets in the table. */ - num_buckets: int, - /** Maximal number of bindings per bucket. */ - max_bucket_length: int, - /** Histogram of bucket sizes. This array [histo] has - length [max_bucket_length + 1]. The value of - [histo.(i)] is the number of buckets whose size is [i]. */ - bucket_histogram: array, -} - -/** [Hashtbl.stats tbl] returns statistics about the table [tbl]: - number of buckets, size of the biggest bucket, distribution of - buckets by size. - @since 4.00.0 */ -let stats: t<'a, 'b> => statistics - -/* {1 Functorial interface} - -The functorial interface allows the use of specific comparison - and hash functions, either for performance/security concerns, - or because keys are not hashable/comparable with the polymorphic builtins. - - For instance, one might want to specialize a table for integer keys: - {[ - module IntHash = - struct - type t = int - let equal i j = i=j - let hash i = i land max_int - end - - module IntHashtbl = Hashtbl.Make(IntHash) - - let h = IntHashtbl.create 17 in - IntHashtbl.add h 12 "hello" - ]} - - This creates a new module [IntHashtbl], with a new type ['a - IntHashtbl.t] of tables from [int] to ['a]. In this example, [h] - contains [string] values so its type is [string IntHashtbl.t]. - - Note that the new type ['a IntHashtbl.t] is not compatible with - the type [('a,'b) Hashtbl.t] of the generic interface. For - example, [Hashtbl.length h] would not type-check, you must use - [IntHashtbl.length]. -*/ - -/** The input signature of the functor {!Hashtbl.Make}. */ -module type HashedType = { - /** The type of the hashtable keys. */ - type t - - /** The equality predicate used to compare keys. */ - let equal: (t, t) => bool - - /** A hashing function on keys. It must be such that if two keys are - equal according to [equal], then they have identical hash values - as computed by [hash]. - Examples: suitable ([equal], [hash]) pairs for arbitrary key - types include -- ([(=)], {!Hashtbl.hash}) for comparing objects by structure - (provided objects do not contain floats) -- ([(fun x y -> compare x y = 0)], {!Hashtbl.hash}) - for comparing objects by structure - and handling {!Pervasives.nan} correctly -- ([(==)], {!Hashtbl.hash}) for comparing objects by physical - equality (e.g. for mutable or cyclic objects). */ - let hash: t => int -} - -/** The output signature of the functor {!Hashtbl.Make}. */ -module type S = { - type key - type t<'a> - let create: int => t<'a> - let clear: t<'a> => unit - /** @since 4.00.0 */ - let reset: t<'a> => unit - - let copy: t<'a> => t<'a> - let add: (t<'a>, key, 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - /** @since 4.05.0 */ - let find_opt: (t<'a>, key) => option<'a> - - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, key, 'a) => unit - let mem: (t<'a>, key) => bool - let iter: ((key, 'a) => unit, t<'a>) => unit - /** @since 4.03.0 */ - let filter_map_inplace: ((key, 'a) => option<'a>, t<'a>) => unit - - let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b - let length: t<'a> => int - /** @since 4.00.0 */ - let stats: t<'a> => statistics -} - -/** Functor building an implementation of the hashtable structure. - The functor [Hashtbl.Make] returns a structure containing - a type [key] of keys and a type ['a t] of hash tables - associating data of type ['a] to keys of type [key]. - The operations perform similarly to those of the generic - interface, but use the hashing and equality functions - specified in the functor argument [H] instead of generic - equality and hashing. Since the hash function is not seeded, - the [create] operation of the result structure always returns - non-randomized hash tables. */ -module Make: (H: HashedType) => (S with type key = H.t) - -/** The input signature of the functor {!Hashtbl.MakeSeeded}. - @since 4.00.0 */ -module type SeededHashedType = { - /** The type of the hashtable keys. */ - type t - - /** The equality predicate used to compare keys. */ - let equal: (t, t) => bool - - /** A seeded hashing function on keys. The first argument is - the seed. It must be the case that if [equal x y] is true, - then [hash seed x = hash seed y] for any value of [seed]. - A suitable choice for [hash] is the function {!Hashtbl.seeded_hash} - below. */ - let hash: (int, t) => int -} - -/** The output signature of the functor {!Hashtbl.MakeSeeded}. - @since 4.00.0 */ -module type SeededS = { - type key - type t<'a> - let create: (~random: bool=?, int) => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, key, 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - /** @since 4.05.0 */ - let find_opt: (t<'a>, key) => option<'a> - - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, key, 'a) => unit - let mem: (t<'a>, key) => bool - let iter: ((key, 'a) => unit, t<'a>) => unit - /** @since 4.03.0 */ - let filter_map_inplace: ((key, 'a) => option<'a>, t<'a>) => unit - - let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics -} - -/** Functor building an implementation of the hashtable structure. - The functor [Hashtbl.MakeSeeded] returns a structure containing - a type [key] of keys and a type ['a t] of hash tables - associating data of type ['a] to keys of type [key]. - The operations perform similarly to those of the generic - interface, but use the seeded hashing and equality functions - specified in the functor argument [H] instead of generic - equality and hashing. The [create] operation of the - result structure supports the [~random] optional parameter - and returns randomized hash tables if [~random:true] is passed - or if randomization is globally on (see {!Hashtbl.randomize}). - @since 4.00.0 */ -module MakeSeeded: (H: SeededHashedType) => (SeededS with type key = H.t) - -/* {1 The polymorphic hash functions} */ - -/** [Hashtbl.hash x] associates a nonnegative integer to any value of - any type. It is guaranteed that - if [x = y] or [Pervasives.compare x y = 0], then [hash x = hash y]. - Moreover, [hash] always terminates, even on cyclic structures. */ -let hash: 'a => int - -/** A variant of {!Hashtbl.hash} that is further parameterized by - an integer seed. - @since 4.00.0 */ -let seeded_hash: (int, 'a) => int - -/** [Hashtbl.hash_param meaningful total x] computes a hash value for [x], - with the same properties as for [hash]. The two extra integer - parameters [meaningful] and [total] give more precise control over - hashing. Hashing performs a breadth-first, left-to-right traversal - of the structure [x], stopping after [meaningful] meaningful nodes - were encountered, or [total] nodes (meaningful or not) were - encountered. If [total] as specified by the user exceeds a certain - value, currently 256, then it is capped to that value. - Meaningful nodes are: integers; floating-point - numbers; strings; characters; booleans; and constant - constructors. Larger values of [meaningful] and [total] means that - more nodes are taken into account to compute the final hash value, - and therefore collisions are less likely to happen. However, - hashing takes longer. The parameters [meaningful] and [total] - govern the tradeoff between accuracy and speed. As default - choices, {!Hashtbl.hash} and {!Hashtbl.seeded_hash} take - [meaningful = 10] and [total = 100]. */ -let hash_param: (int, int, 'a) => int - -/** A variant of {!Hashtbl.hash_param} that is further parameterized by - an integer seed. Usage: - [Hashtbl.seeded_hash_param meaningful total seed x]. - @since 4.00.0 */ -let seeded_hash_param: (int, int, int, 'a) => int diff --git a/jscomp/stdlib-406/hashtblLabels.res b/jscomp/stdlib-406/hashtblLabels.res deleted file mode 100644 index e9fe63a1fa..0000000000 --- a/jscomp/stdlib-406/hashtblLabels.res +++ /dev/null @@ -1,129 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/* Hash tables */ - -type t<'a, 'b> = Hashtbl.t<'a, 'b> - -let { - create, - clear, - reset, - copy, - add, - find, - find_opt, - find_all, - mem, - remove, - replace, - iter, - filter_map_inplace, - fold, - length, - randomize, - is_randomized, - stats, - hash, - seeded_hash, - hash_param, - seeded_hash_param, -} = module(Hashtbl) - -let add = (tbl, ~key, ~data) => add(tbl, key, data) - -let replace = (tbl, ~key, ~data) => replace(tbl, key, data) - -let iter = (~f, tbl) => iter((key, data) => f(~key, ~data), tbl) - -let filter_map_inplace = (~f, tbl) => filter_map_inplace((key, data) => f(~key, ~data), tbl) - -let fold = (~f, tbl, ~init) => fold((key, data, acc) => f(~key, ~data, acc), tbl, init) - -type statistics = Hashtbl.statistics = { - num_bindings: int, - num_buckets: int, - max_bucket_length: int, - bucket_histogram: array, -} - -/* Functorial interface */ - -module type HashedType = Hashtbl.HashedType - -module type SeededHashedType = Hashtbl.SeededHashedType - -module type S = { - type rec key - and t<'a> - let create: int => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, ~key: key, ~data: 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - let find_opt: (t<'a>, key) => option<'a> - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, ~key: key, ~data: 'a) => unit - let mem: (t<'a>, key) => bool - let iter: (~f: (~key: key, ~data: 'a) => unit, t<'a>) => unit - let filter_map_inplace: (~f: (~key: key, ~data: 'a) => option<'a>, t<'a>) => unit - let fold: (~f: (~key: key, ~data: 'a, 'b) => 'b, t<'a>, ~init: 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics -} - -module type SeededS = { - type rec key - and t<'a> - let create: (~random: bool=?, int) => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, ~key: key, ~data: 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - let find_opt: (t<'a>, key) => option<'a> - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, ~key: key, ~data: 'a) => unit - let mem: (t<'a>, key) => bool - let iter: (~f: (~key: key, ~data: 'a) => unit, t<'a>) => unit - let filter_map_inplace: (~f: (~key: key, ~data: 'a) => option<'a>, t<'a>) => unit - let fold: (~f: (~key: key, ~data: 'a, 'b) => 'b, t<'a>, ~init: 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics -} - -module MakeSeeded = (H: SeededHashedType): (SeededS with type key = H.t) => { - include Hashtbl.MakeSeeded(H) - let add = (tbl, ~key, ~data) => add(tbl, key, data) - let replace = (tbl, ~key, ~data) => replace(tbl, key, data) - - let iter = (~f, tbl) => iter((key, data) => f(~key, ~data), tbl) - - let filter_map_inplace = (~f, tbl) => filter_map_inplace((key, data) => f(~key, ~data), tbl) - - let fold = (~f, tbl, ~init) => fold((key, data, acc) => f(~key, ~data, acc), tbl, init) -} - -module Make = (H: HashedType): (S with type key = H.t) => { - include MakeSeeded({ - type t = H.t - let equal = H.equal - let hash = (_seed: int, x) => H.hash(x) - }) - let create = sz => create(~random=false, sz) -} diff --git a/jscomp/stdlib-406/moreLabels.res b/jscomp/stdlib-406/moreLabels.res deleted file mode 100644 index 2fb9e46e70..0000000000 --- a/jscomp/stdlib-406/moreLabels.res +++ /dev/null @@ -1,22 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Jacques Garrigue, Kyoto University RIMS */ -/* */ -/* Copyright 2001 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/* Module [MoreLabels]: meta-module for compatibility labelled libraries */ - -module Hashtbl = HashtblLabels - -module Map = MapLabels - -module Set = SetLabels diff --git a/jscomp/stdlib-406/moreLabels.resi b/jscomp/stdlib-406/moreLabels.resi deleted file mode 100644 index 397641d669..0000000000 --- a/jscomp/stdlib-406/moreLabels.resi +++ /dev/null @@ -1,182 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Jacques Garrigue, Kyoto University RIMS */ -/* */ -/* Copyright 2001 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/*** Extra labeled libraries. - - This meta-module provides labelized version of the {!Hashtbl}, - {!Map} and {!Set} modules. - - They only differ by their labels. They are provided to help - porting from previous versions of OCaml. - The contents of this module are subject to change. -*/ - -module Hashtbl: { - type t<'a, 'b> = Hashtbl.t<'a, 'b> - let create: (~random: bool=?, int) => t<'a, 'b> - let clear: t<'a, 'b> => unit - let reset: t<'a, 'b> => unit - let copy: t<'a, 'b> => t<'a, 'b> - let add: (t<'a, 'b>, ~key: 'a, ~data: 'b) => unit - let find: (t<'a, 'b>, 'a) => 'b - let find_opt: (t<'a, 'b>, 'a) => option<'b> - let find_all: (t<'a, 'b>, 'a) => list<'b> - let mem: (t<'a, 'b>, 'a) => bool - let remove: (t<'a, 'b>, 'a) => unit - let replace: (t<'a, 'b>, ~key: 'a, ~data: 'b) => unit - let iter: (~f: (~key: 'a, ~data: 'b) => unit, t<'a, 'b>) => unit - let filter_map_inplace: (~f: (~key: 'a, ~data: 'b) => option<'b>, t<'a, 'b>) => unit - let fold: (~f: (~key: 'a, ~data: 'b, 'c) => 'c, t<'a, 'b>, ~init: 'c) => 'c - let length: t<'a, 'b> => int - let randomize: unit => unit - let is_randomized: unit => bool - type statistics = Hashtbl.statistics - let stats: t<'a, 'b> => statistics - module type HashedType = Hashtbl.HashedType - module type SeededHashedType = Hashtbl.SeededHashedType - module type S = { - type rec key - and t<'a> - let create: int => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, ~key: key, ~data: 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - let find_opt: (t<'a>, key) => option<'a> - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, ~key: key, ~data: 'a) => unit - let mem: (t<'a>, key) => bool - let iter: (~f: (~key: key, ~data: 'a) => unit, t<'a>) => unit - let filter_map_inplace: (~f: (~key: key, ~data: 'a) => option<'a>, t<'a>) => unit - let fold: (~f: (~key: key, ~data: 'a, 'b) => 'b, t<'a>, ~init: 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics - } - module type SeededS = { - type rec key - and t<'a> - let create: (~random: bool=?, int) => t<'a> - let clear: t<'a> => unit - let reset: t<'a> => unit - let copy: t<'a> => t<'a> - let add: (t<'a>, ~key: key, ~data: 'a) => unit - let remove: (t<'a>, key) => unit - let find: (t<'a>, key) => 'a - let find_opt: (t<'a>, key) => option<'a> - let find_all: (t<'a>, key) => list<'a> - let replace: (t<'a>, ~key: key, ~data: 'a) => unit - let mem: (t<'a>, key) => bool - let iter: (~f: (~key: key, ~data: 'a) => unit, t<'a>) => unit - let filter_map_inplace: (~f: (~key: key, ~data: 'a) => option<'a>, t<'a>) => unit - let fold: (~f: (~key: key, ~data: 'a, 'b) => 'b, t<'a>, ~init: 'b) => 'b - let length: t<'a> => int - let stats: t<'a> => statistics - } - module Make: (H: HashedType) => (S with type key = H.t) - module MakeSeeded: (H: SeededHashedType) => (SeededS with type key = H.t) - let hash: 'a => int - let seeded_hash: (int, 'a) => int - let hash_param: (int, int, 'a) => int - let seeded_hash_param: (int, int, int, 'a) => int -} - -module Map: { - module type OrderedType = Map.OrderedType - module type S = { - type rec key - and t<+'a> - let empty: t<'a> - let is_empty: t<'a> => bool - let mem: (key, t<'a>) => bool - let add: (~key: key, ~data: 'a, t<'a>) => t<'a> - let update: (~key: key, ~f: option<'a> => option<'a>, t<'a>) => t<'a> - let singleton: (key, 'a) => t<'a> - let remove: (key, t<'a>) => t<'a> - let merge: (~f: (key, option<'a>, option<'b>) => option<'c>, t<'a>, t<'b>) => t<'c> - let union: (~f: (key, 'a, 'a) => option<'a>, t<'a>, t<'a>) => t<'a> - let compare: (~cmp: ('a, 'a) => int, t<'a>, t<'a>) => int - let equal: (~cmp: ('a, 'a) => bool, t<'a>, t<'a>) => bool - let iter: (~f: (~key: key, ~data: 'a) => unit, t<'a>) => unit - let fold: (~f: (~key: key, ~data: 'a, 'b) => 'b, t<'a>, ~init: 'b) => 'b - let for_all: (~f: (key, 'a) => bool, t<'a>) => bool - let exists: (~f: (key, 'a) => bool, t<'a>) => bool - let filter: (~f: (key, 'a) => bool, t<'a>) => t<'a> - let partition: (~f: (key, 'a) => bool, t<'a>) => (t<'a>, t<'a>) - let cardinal: t<'a> => int - let bindings: t<'a> => list<(key, 'a)> - let min_binding: t<'a> => (key, 'a) - let min_binding_opt: t<'a> => option<(key, 'a)> - let max_binding: t<'a> => (key, 'a) - let max_binding_opt: t<'a> => option<(key, 'a)> - let choose: t<'a> => (key, 'a) - let choose_opt: t<'a> => option<(key, 'a)> - let split: (key, t<'a>) => (t<'a>, option<'a>, t<'a>) - let find: (key, t<'a>) => 'a - let find_opt: (key, t<'a>) => option<'a> - let find_first: (~f: key => bool, t<'a>) => (key, 'a) - let find_first_opt: (~f: key => bool, t<'a>) => option<(key, 'a)> - let find_last: (~f: key => bool, t<'a>) => (key, 'a) - let find_last_opt: (~f: key => bool, t<'a>) => option<(key, 'a)> - let map: (~f: 'a => 'b, t<'a>) => t<'b> - let mapi: (~f: (key, 'a) => 'b, t<'a>) => t<'b> - } - module Make: (Ord: OrderedType) => (S with type key = Ord.t) -} - -module Set: { - module type OrderedType = Set.OrderedType - module type S = { - type rec elt - and t - let empty: t - let is_empty: t => bool - let mem: (elt, t) => bool - let add: (elt, t) => t - let singleton: elt => t - let remove: (elt, t) => t - let union: (t, t) => t - let inter: (t, t) => t - let diff: (t, t) => t - let compare: (t, t) => int - let equal: (t, t) => bool - let subset: (t, t) => bool - let iter: (~f: elt => unit, t) => unit - let map: (~f: elt => elt, t) => t - let fold: (~f: (elt, 'a) => 'a, t, ~init: 'a) => 'a - let for_all: (~f: elt => bool, t) => bool - let exists: (~f: elt => bool, t) => bool - let filter: (~f: elt => bool, t) => t - let partition: (~f: elt => bool, t) => (t, t) - let cardinal: t => int - let elements: t => list - let min_elt: t => elt - let min_elt_opt: t => option - let max_elt: t => elt - let max_elt_opt: t => option - let choose: t => elt - let choose_opt: t => option - let split: (elt, t) => (t, bool, t) - let find: (elt, t) => elt - let find_opt: (elt, t) => option - let find_first: (~f: elt => bool, t) => elt - let find_first_opt: (~f: elt => bool, t) => option - let find_last: (~f: elt => bool, t) => elt - let find_last_opt: (~f: elt => bool, t) => option - let of_list: list => t - } - module Make: (Ord: OrderedType) => (S with type elt = Ord.t) -} diff --git a/jscomp/stdlib-406/random.res b/jscomp/stdlib-406/random.res deleted file mode 100644 index 5dd837add8..0000000000 --- a/jscomp/stdlib-406/random.res +++ /dev/null @@ -1,336 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Damien Doligez, projet Para, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/* Pseudo-random number generator - This is a lagged-Fibonacci F(55, 24, +) with a modified addition - function to enhance the mixing of bits. - If we use normal addition, the low-order bit fails tests 1 and 7 - of the Diehard test suite, and bits 1 and 2 also fail test 7. - If we use multiplication as suggested by Marsaglia, it doesn't fare - much better. - By mixing the bits of one of the numbers before addition (XOR the - 5 high-order bits into the low-order bits), we get a generator that - passes all the Diehard tests. -*/ - -let random_seed: unit => array = _ => { - let seed: int = %raw("Math.floor(Math.random()*0x7fffffff)") - [seed] -} - -module State = { - type t = {st: array, mutable idx: int} - - let new_state = () => {st: Array.make(55, 0), idx: 0} - let assign = (st1, st2) => { - Array.blit(st2.st, 0, st1.st, 0, 55) - st1.idx = st2.idx - } - - let full_init = (s, seed) => { - let combine = (accu, x) => Digest.string(accu ++ Js.Int.toString(x)) - let extract = d => - Char.code(String.get(d, 0)) + - lsl(Char.code(String.get(d, 1)), 8) + - lsl(Char.code(String.get(d, 2)), 16) + - lsl(Char.code(String.get(d, 3)), 24) - - let seed = if Array.length(seed) == 0 { - [0] - } else { - seed - } - let l = Array.length(seed) - for i in 0 to 54 { - s.st[i] = i - } - let accu = ref("x") - for i in 0 to 54 + max(55, l) { - let j = mod(i, 55) - let k = mod(i, l) - accu := combine(accu.contents, seed[k]) - s.st[j] = land(lxor(s.st[j], extract(accu.contents)), 0x3FFFFFFF) /* PR#5575 */ - } - s.idx = 0 - } - - let make = seed => { - let result = new_state() - full_init(result, seed) - result - } - - let make_self_init = () => make(random_seed()) - - let copy = s => { - let result = new_state() - assign(result, s) - result - } - - /* Returns 30 random bits as an integer 0 <= x < 1073741824 */ - let bits = s => { - s.idx = mod(s.idx + 1, 55) - let curval = s.st[s.idx] - let newval = s.st[mod(s.idx + 24, 55)] + lxor(curval, land(lsr(curval, 25), 0x1F)) - let newval30 = land(newval, 0x3FFFFFFF) /* PR#5575 */ - s.st[s.idx] = newval30 - newval30 - } - - let rec intaux = (s, n) => { - let r = bits(s) - let v = mod(r, n) - if r - v > 0x3FFFFFFF - n + 1 { - intaux(s, n) - } else { - v - } - } - - let int = (s, bound) => - if bound > 0x3FFFFFFF || bound <= 0 { - invalid_arg("Random.int") - } else { - intaux(s, bound) - } - - let rec int32aux = (s, n) => { - let b1 = Int32.of_int(bits(s)) - let b2 = Int32.shift_left(Int32.of_int(land(bits(s), 1)), 30) - let r = Int32.logor(b1, b2) - let v = Int32.rem(r, n) - if Int32.sub(r, v) > Int32.add(Int32.sub(Int32.max_int, n), 1l) { - int32aux(s, n) - } else { - v - } - } - - let int32 = (s, bound) => - if bound <= 0l { - invalid_arg("Random.int32") - } else { - int32aux(s, bound) - } - - let rec int64aux = (s, n) => { - let b1 = Int64.of_int(bits(s)) - let b2 = Int64.shift_left(Int64.of_int(bits(s)), 30) - let b3 = Int64.shift_left(Int64.of_int(land(bits(s), 7)), 60) - let r = Int64.logor(b1, Int64.logor(b2, b3)) - let v = Int64.rem(r, n) - if Int64.sub(r, v) > Int64.add(Int64.sub(Int64.max_int, n), 1L) { - int64aux(s, n) - } else { - v - } - } - - let int64 = (s, bound) => - if bound <= 0L { - invalid_arg("Random.int64") - } else { - int64aux(s, bound) - } - - /* Returns a float 0 <= x <= 1 with at most 60 bits of precision. */ - let rawfloat = s => { - let scale = 1073741824.0 /* 2^30 */ - and r1 = Pervasives.float(bits(s)) - and r2 = Pervasives.float(bits(s)) - (r1 /. scale +. r2) /. scale - } - - let float = (s, bound) => rawfloat(s) *. bound - - let bool = s => land(bits(s), 1) == 0 -} - -/* This is the state you get with [init 27182818] and then applying - the "land 0x3FFFFFFF" filter to them. See #5575, #5793, #5977. */ -let default = { - State.st: [ - 0x3ae2522b, - 0x1d8d4634, - 0x15b4fad0, - 0x18b14ace, - 0x12f8a3c4, - 0x3b086c47, - 0x16d467d6, - 0x101d91c7, - 0x321df177, - 0x0176c193, - 0x1ff72bf1, - 0x1e889109, - 0x0b464b18, - 0x2b86b97c, - 0x0891da48, - 0x03137463, - 0x085ac5a1, - 0x15d61f2f, - 0x3bced359, - 0x29c1c132, - 0x3a86766e, - 0x366d8c86, - 0x1f5b6222, - 0x3ce1b59f, - 0x2ebf78e1, - 0x27cd1b86, - 0x258f3dc3, - 0x389a8194, - 0x02e4c44c, - 0x18c43f7d, - 0x0f6e534f, - 0x1e7df359, - 0x055d0b7e, - 0x10e84e7e, - 0x126198e4, - 0x0e7722cb, - 0x1cbede28, - 0x3391b964, - 0x3d40e92a, - 0x0c59933d, - 0x0b8cd0b7, - 0x24efff1c, - 0x2803fdaa, - 0x08ebc72e, - 0x0f522e32, - 0x05398edc, - 0x2144a04c, - 0x0aef3cbd, - 0x01ad4719, - 0x35b93cd6, - 0x2a559d4f, - 0x1e6fd768, - 0x26e27f36, - 0x186f18c3, - 0x2fbf967a, - ], - State.idx: 0, -} - -let bits = () => State.bits(default) -let int = bound => State.int(default, bound) -let int32 = bound => State.int32(default, bound) - -let int64 = bound => State.int64(default, bound) -let float = scale => State.float(default, scale) -let bool = () => State.bool(default) - -let full_init = seed => State.full_init(default, seed) -let init = seed => State.full_init(default, [seed]) -let self_init = () => full_init(random_seed()) - -/* Manipulating the current state. */ - -let get_state = () => State.copy(default) -let set_state = s => State.assign(default, s) - -/* ******************* - -(* Test functions. Not included in the library. - The [chisquare] function should be called with n > 10r. - It returns a triple (low, actual, high). - If low <= actual <= high, the [g] function passed the test, - otherwise it failed. - - Some results: - -init 27182818; chisquare int 100000 1000 -init 27182818; chisquare int 100000 100 -init 27182818; chisquare int 100000 5000 -init 27182818; chisquare int 1000000 1000 -init 27182818; chisquare int 100000 1024 -init 299792643; chisquare int 100000 1024 -init 14142136; chisquare int 100000 1024 -init 27182818; init_diff 1024; chisquare diff 100000 1024 -init 27182818; init_diff 100; chisquare diff 100000 100 -init 27182818; init_diff2 1024; chisquare diff2 100000 1024 -init 27182818; init_diff2 100; chisquare diff2 100000 100 -init 14142136; init_diff2 100; chisquare diff2 100000 100 -init 299792643; init_diff2 100; chisquare diff2 100000 100 -- : float * float * float = (936.754446796632465, 997.5, 1063.24555320336754) -# - : float * float * float = (80., 89.7400000000052387, 120.) -# - : float * float * float = (4858.57864376269, 5045.5, 5141.42135623731) -# - : float * float * float = -(936.754446796632465, 944.805999999982305, 1063.24555320336754) -# - : float * float * float = (960., 1019.19744000000355, 1088.) -# - : float * float * float = (960., 1059.31776000000536, 1088.) -# - : float * float * float = (960., 1039.98463999999512, 1088.) -# - : float * float * float = (960., 1054.38207999999577, 1088.) -# - : float * float * float = (80., 90.096000000005, 120.) -# - : float * float * float = (960., 1076.78720000000612, 1088.) -# - : float * float * float = (80., 85.1760000000067521, 120.) -# - : float * float * float = (80., 85.2160000000003492, 120.) -# - : float * float * float = (80., 80.6220000000030268, 120.) - -*) - -(* Return the sum of the squares of v[i0,i1[ *) -let rec sumsq v i0 i1 = - if i0 >= i1 then 0.0 - else if i1 = i0 + 1 then Pervasives.float v.(i0) *. Pervasives.float v.(i0) - else sumsq v i0 ((i0+i1)/2) +. sumsq v ((i0+i1)/2) i1 - - -let chisquare g n r = - if n <= 10 * r then invalid_arg "chisquare"; - let f = Array.make r 0 in - for i = 1 to n do - let t = g r in - f.(t) <- f.(t) + 1 - done; - let t = sumsq f 0 r - and r = Pervasives.float r - and n = Pervasives.float n in - let sr = 2.0 *. sqrt r in - (r -. sr, (r *. t /. n) -. n, r +. sr) - - -(* This is to test for linear dependencies between successive random numbers. -*) -let st = ref 0 -let init_diff r = st := int r -let diff r = - let x1 = !st - and x2 = int r - in - st := x2; - if x1 >= x2 then - x1 - x2 - else - r + x1 - x2 - - -let st1 = ref 0 -and st2 = ref 0 - - -(* This is to test for quadratic dependencies between successive random - numbers. -*) -let init_diff2 r = st1 := int r; st2 := int r -let diff2 r = - let x1 = !st1 - and x2 = !st2 - and x3 = int r - in - st1 := x2; - st2 := x3; - (x3 - x2 - x2 + x1 + 2*r) mod r - - -********************/ diff --git a/jscomp/stdlib-406/random.resi b/jscomp/stdlib-406/random.resi deleted file mode 100644 index 05624c98eb..0000000000 --- a/jscomp/stdlib-406/random.resi +++ /dev/null @@ -1,100 +0,0 @@ -/* ************************************************************************ */ -/* */ -/* OCaml */ -/* */ -/* Damien Doligez, projet Para, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. */ -/* */ -/* All rights reserved. This file is distributed under the terms of */ -/* the GNU Lesser General Public License version 2.1, with the */ -/* special exception on linking described in the file LICENSE. */ -/* */ -/* ************************************************************************ */ - -/*** Pseudo-random number generators (PRNG). */ - -/* {1 Basic functions} */ - -/** Initialize the generator, using the argument as a seed. - The same seed will always yield the same sequence of numbers. */ -let init: int => unit - -/** Same as {!Random.init} but takes more data as seed. */ -let full_init: array => unit - -/** Initialize the generator with a random seed chosen - in a system-dependent way. If [/dev/urandom] is available on - the host machine, it is used to provide a highly random initial - seed. Otherwise, a less random seed is computed from system - parameters (current time, process IDs). */ -let self_init: unit => unit - -/** Return 30 random bits in a nonnegative integer. - @before 3.12.0 used a different algorithm (affects all the following - functions) -*/ -let bits: unit => int - -/** [Random.int bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0 and less - than 2{^30}. */ -let int: int => int - -/** [Random.int32 bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0. */ -let int32: Int32.t => Int32.t - -/** [Random.int64 bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0. */ -let int64: Int64.t => Int64.t - -/** [Random.float bound] returns a random floating-point number - between 0 and [bound] (inclusive). If [bound] is - negative, the result is negative or zero. If [bound] is 0, - the result is 0. */ -let float: float => float - -/** [Random.bool ()] returns [true] or [false] with probability 0.5 each. */ -let bool: unit => bool - -/* {1 Advanced functions} */ - -module State: { - /*** The functions from module {!State} manipulate the current state - of the random generator explicitly. - This allows using one or several deterministic PRNGs, - even in a multi-threaded program, without interference from - other parts of the program. - */ - - /** The type of PRNG states. */ - type t - - /** Create a new state and initialize it with the given seed. */ - let make: array => t - - /** Create a new state and initialize it with a system-dependent - low-entropy seed. */ - let make_self_init: unit => t - - /** Return a copy of the given state. */ - let copy: t => t - - let bits: t => int - let int: (t, int) => int - let int32: (t, Int32.t) => Int32.t - let int64: (t, Int64.t) => Int64.t - let float: (t, float) => float - /** These functions are the same as the basic functions, except that they - use (and update) the given PRNG state instead of the default one. - */ - let bool: t => bool -} - -/** Return the current state of the generator used by the basic functions. */ -let get_state: unit => State.t - -/** Set the state of the generator used by the basic functions. */ -let set_state: State.t => unit diff --git a/jscomp/stdlib-406/release.ninja b/jscomp/stdlib-406/release.ninja index b7b7476685..f89de97c89 100644 --- a/jscomp/stdlib-406/release.ninja +++ b/jscomp/stdlib-406/release.ninja @@ -30,11 +30,6 @@ o stdlib-406/char.cmj : cc_cmi stdlib-406/char.res | stdlib-406/char.cmi $bsc ot o stdlib-406/char.cmi : cc stdlib-406/char.resi | stdlib-406/pervasives.cmj $bsc others o stdlib-406/complex.cmj : cc_cmi stdlib-406/complex.res | stdlib-406/complex.cmi $bsc others o stdlib-406/complex.cmi : cc stdlib-406/complex.resi | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/digest.cmj : cc_cmi stdlib-406/digest.res | stdlib-406/bytes.cmj stdlib-406/char.cmj stdlib-406/digest.cmi stdlib-406/string.cmj $bsc others -o stdlib-406/digest.cmi : cc stdlib-406/digest.resi | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/hashtbl.cmj : cc_cmi stdlib-406/hashtbl.res | stdlib-406/array.cmj stdlib-406/hashtbl.cmi stdlib-406/lazy.cmj stdlib-406/random.cmj $bsc others -o stdlib-406/hashtbl.cmi : cc stdlib-406/hashtbl.resi | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/hashtblLabels.cmi stdlib-406/hashtblLabels.cmj : cc stdlib-406/hashtblLabels.res | stdlib-406/hashtbl.cmj stdlib-406/pervasives.cmj $bsc others o stdlib-406/int32.cmj : cc_cmi stdlib-406/int32.res | stdlib-406/int32.cmi $bsc others o stdlib-406/int32.cmi : cc stdlib-406/int32.resi | stdlib-406/pervasives.cmj $bsc others o stdlib-406/int64.cmj : cc_cmi stdlib-406/int64.res | stdlib-406/int64.cmi $bsc others @@ -48,14 +43,10 @@ o stdlib-406/listLabels.cmi : cc stdlib-406/listLabels.resi | stdlib-406/pervasi o stdlib-406/map.cmj : cc_cmi stdlib-406/map.res | stdlib-406/map.cmi $bsc others o stdlib-406/map.cmi : cc stdlib-406/map.resi | stdlib-406/pervasives.cmj $bsc others o stdlib-406/mapLabels.cmi stdlib-406/mapLabels.cmj : cc stdlib-406/mapLabels.res | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/moreLabels.cmj : cc_cmi stdlib-406/moreLabels.res | stdlib-406/hashtblLabels.cmj stdlib-406/mapLabels.cmj stdlib-406/moreLabels.cmi stdlib-406/setLabels.cmj $bsc others -o stdlib-406/moreLabels.cmi : cc stdlib-406/moreLabels.resi | stdlib-406/hashtbl.cmi stdlib-406/map.cmi stdlib-406/pervasives.cmj stdlib-406/set.cmi $bsc others o stdlib-406/obj.cmj : cc_cmi stdlib-406/obj.res | stdlib-406/obj.cmi $bsc others o stdlib-406/obj.cmi : cc stdlib-406/obj.resi | stdlib-406/pervasives.cmj $bsc others o stdlib-406/queue.cmj : cc_cmi stdlib-406/queue.res | stdlib-406/queue.cmi $bsc others o stdlib-406/queue.cmi : cc stdlib-406/queue.resi | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/random.cmj : cc_cmi stdlib-406/random.res | stdlib-406/array.cmj stdlib-406/char.cmj stdlib-406/digest.cmj stdlib-406/int32.cmj stdlib-406/int64.cmj stdlib-406/random.cmi $bsc others -o stdlib-406/random.cmi : cc stdlib-406/random.resi | stdlib-406/int32.cmi stdlib-406/int64.cmi stdlib-406/pervasives.cmj $bsc others o stdlib-406/set.cmj : cc_cmi stdlib-406/set.res | stdlib-406/list.cmj stdlib-406/set.cmi $bsc others o stdlib-406/set.cmi : cc stdlib-406/set.resi | stdlib-406/pervasives.cmj $bsc others o stdlib-406/setLabels.cmi stdlib-406/setLabels.cmj : cc stdlib-406/setLabels.res | stdlib-406/list.cmj stdlib-406/pervasives.cmj $bsc others @@ -71,4 +62,4 @@ o stdlib-406/string.cmj : cc_cmi stdlib-406/string.res | stdlib-406/array.cmj st o stdlib-406/string.cmi : cc stdlib-406/string.resi | stdlib-406/pervasives.cmj $bsc others o stdlib-406/stringLabels.cmj : cc_cmi stdlib-406/stringLabels.res | stdlib-406/array.cmj stdlib-406/bytes.cmj stdlib-406/stringLabels.cmi $bsc others o stdlib-406/stringLabels.cmi : cc stdlib-406/stringLabels.resi | stdlib-406/pervasives.cmj $bsc others -o $stdlib : phony stdlib-406/array.cmi stdlib-406/array.cmj stdlib-406/arrayLabels.cmi stdlib-406/arrayLabels.cmj stdlib-406/bytes.cmi stdlib-406/bytes.cmj stdlib-406/bytesLabels.cmi stdlib-406/bytesLabels.cmj stdlib-406/callback.cmi stdlib-406/callback.cmj stdlib-406/camlinternalLazy.cmi stdlib-406/camlinternalLazy.cmj stdlib-406/camlinternalMod.cmi stdlib-406/camlinternalMod.cmj stdlib-406/char.cmi stdlib-406/char.cmj stdlib-406/complex.cmi stdlib-406/complex.cmj stdlib-406/digest.cmi stdlib-406/digest.cmj stdlib-406/hashtbl.cmi stdlib-406/hashtbl.cmj stdlib-406/hashtblLabels.cmi stdlib-406/hashtblLabels.cmj stdlib-406/int32.cmi stdlib-406/int32.cmj stdlib-406/int64.cmi stdlib-406/int64.cmj stdlib-406/lazy.cmi stdlib-406/lazy.cmj stdlib-406/list.cmi stdlib-406/list.cmj stdlib-406/listLabels.cmi stdlib-406/listLabels.cmj stdlib-406/map.cmi stdlib-406/map.cmj stdlib-406/mapLabels.cmi stdlib-406/mapLabels.cmj stdlib-406/moreLabels.cmi stdlib-406/moreLabels.cmj stdlib-406/obj.cmi stdlib-406/obj.cmj stdlib-406/queue.cmi stdlib-406/queue.cmj stdlib-406/random.cmi stdlib-406/random.cmj stdlib-406/set.cmi stdlib-406/set.cmj stdlib-406/setLabels.cmi stdlib-406/setLabels.cmj stdlib-406/sort.cmi stdlib-406/sort.cmj stdlib-406/stack.cmi stdlib-406/stack.cmj stdlib-406/stdLabels.cmi stdlib-406/stdLabels.cmj stdlib-406/stream.cmi stdlib-406/stream.cmj stdlib-406/string.cmi stdlib-406/string.cmj stdlib-406/stringLabels.cmi stdlib-406/stringLabels.cmj +o $stdlib : phony stdlib-406/array.cmi stdlib-406/array.cmj stdlib-406/arrayLabels.cmi stdlib-406/arrayLabels.cmj stdlib-406/bytes.cmi stdlib-406/bytes.cmj stdlib-406/bytesLabels.cmi stdlib-406/bytesLabels.cmj stdlib-406/callback.cmi stdlib-406/callback.cmj stdlib-406/camlinternalLazy.cmi stdlib-406/camlinternalLazy.cmj stdlib-406/camlinternalMod.cmi stdlib-406/camlinternalMod.cmj stdlib-406/char.cmi stdlib-406/char.cmj stdlib-406/complex.cmi stdlib-406/complex.cmj stdlib-406/int32.cmi stdlib-406/int32.cmj stdlib-406/int64.cmi stdlib-406/int64.cmj stdlib-406/lazy.cmi stdlib-406/lazy.cmj stdlib-406/list.cmi stdlib-406/list.cmj stdlib-406/listLabels.cmi stdlib-406/listLabels.cmj stdlib-406/map.cmi stdlib-406/map.cmj stdlib-406/mapLabels.cmi stdlib-406/mapLabels.cmj stdlib-406/obj.cmi stdlib-406/obj.cmj stdlib-406/queue.cmi stdlib-406/queue.cmj stdlib-406/set.cmi stdlib-406/set.cmj stdlib-406/setLabels.cmi stdlib-406/setLabels.cmj stdlib-406/sort.cmi stdlib-406/sort.cmj stdlib-406/stack.cmi stdlib-406/stack.cmj stdlib-406/stdLabels.cmi stdlib-406/stdLabels.cmj stdlib-406/stream.cmi stdlib-406/stream.cmj stdlib-406/string.cmi stdlib-406/string.cmj stdlib-406/stringLabels.cmi stdlib-406/stringLabels.cmj