From b6c9ee9ab45635a5f69133ad9cebb121768fee13 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Thu, 3 Aug 2023 17:57:14 +0200 Subject: [PATCH 1/9] stdlib-406: remove unused files --- jscomp/stdlib-406/Compflags | 30 -------------- jscomp/stdlib-406/Makefile.nt | 16 -------- jscomp/stdlib-406/StdlibModules | 72 --------------------------------- 3 files changed, 118 deletions(-) delete mode 100755 jscomp/stdlib-406/Compflags delete mode 100644 jscomp/stdlib-406/Makefile.nt delete mode 100644 jscomp/stdlib-406/StdlibModules diff --git a/jscomp/stdlib-406/Compflags b/jscomp/stdlib-406/Compflags deleted file mode 100755 index a5fd8f8345..0000000000 --- a/jscomp/stdlib-406/Compflags +++ /dev/null @@ -1,30 +0,0 @@ -#!/bin/sh -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -#* * -#* Copyright 2004 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -case $1 in - pervasives.cm[ioxj]|pervasives.p.cmx) echo ' -nopervasives';; - camlinternalOO.cmi) echo ' -nopervasives';; - # camlinternalOO.cmx|camlinternalOO.p.cmx) echo ' -inline 0';; - # buffer.cmx|buffer.p.cmx) echo ' -inline 3';; - # make sure add_char is inlined (PR#5872) - buffer.cm[ioj]) echo ' -w A';; - camlinternalFormat.cm[ioj]) echo ' -w Ae';; - camlinternalFormatBasics*.cm[ioxj]) echo ' -nopervasives';; - printf.cm[ioj]|format.cm[ioj]|scanf.cm[ioj]) echo ' -w Ae';; - # scanf.cmx|scanf.p.cmx) echo ' -inline 9';; - *Labels.cm[oxj]|*Labels.p.cmx) echo ' -nolabels -no-alias-deps';; - *) echo ' ';; -esac diff --git a/jscomp/stdlib-406/Makefile.nt b/jscomp/stdlib-406/Makefile.nt deleted file mode 100644 index ed9900bb9a..0000000000 --- a/jscomp/stdlib-406/Makefile.nt +++ /dev/null @@ -1,16 +0,0 @@ -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -#* * -#* Copyright 1999 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -include Makefile diff --git a/jscomp/stdlib-406/StdlibModules b/jscomp/stdlib-406/StdlibModules deleted file mode 100644 index 2820740144..0000000000 --- a/jscomp/stdlib-406/StdlibModules +++ /dev/null @@ -1,72 +0,0 @@ -# -*- Makefile -*- - -#************************************************************************** -#* * -#* OCaml * -#* * -#* Xavier Leroy, projet Cristal, INRIA Rocquencourt * -#* * -#* Copyright 2002 Institut National de Recherche en Informatique et * -#* en Automatique. * -#* * -#* All rights reserved. This file is distributed under the terms of * -#* the GNU Lesser General Public License version 2.1, with the * -#* special exception on linking described in the file LICENSE. * -#* * -#************************************************************************** - -# This file lists all standard library modules. -# It is used in particular to know what to expunge in toplevels. - -STDLIB_MODULES=\ - spacetime \ - arg \ - array \ - arrayLabels \ - buffer \ - bytes \ - bytesLabels \ - callback \ - camlinternalFormat \ - camlinternalFormatBasics \ - camlinternalLazy \ - camlinternalMod \ - camlinternalOO \ - char \ - complex \ - digest \ - ephemeron \ - filename \ - format \ - gc \ - genlex \ - hashtbl \ - int32 \ - int64 \ - lazy \ - lexing \ - list \ - listLabels \ - map \ - marshal \ - moreLabels \ - nativeint \ - obj \ - oo \ - parsing \ - pervasives \ - printexc \ - printf \ - queue \ - random \ - scanf \ - set \ - sort \ - stack \ - stdLabels \ - stream \ - string \ - stringLabels \ - sys \ - uchar \ - weak From de270e9fcfa23ffb1f0125d4eab76fe47cae50db Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Mon, 7 Aug 2023 09:49:43 +0200 Subject: [PATCH 2/9] Convert OCaml stdlib to .res syntax --- jscomp/stdlib-406/array.ml | 307 ------- jscomp/stdlib-406/array.mli | 275 ------- jscomp/stdlib-406/array.res | 410 ++++++++++ jscomp/stdlib-406/array.resi | 267 +++++++ jscomp/stdlib-406/arrayLabels.ml | 307 ------- jscomp/stdlib-406/arrayLabels.mli | 276 ------- jscomp/stdlib-406/arrayLabels.res | 410 ++++++++++ jscomp/stdlib-406/arrayLabels.resi | 268 +++++++ jscomp/stdlib-406/buffer.ml | 250 ------ jscomp/stdlib-406/buffer.mli | 149 ---- jscomp/stdlib-406/buffer.res | 307 +++++++ jscomp/stdlib-406/buffer.resi | 148 ++++ jscomp/stdlib-406/bytes.ml | 431 ---------- jscomp/stdlib-406/bytes.res | Bin 0 -> 13113 bytes jscomp/stdlib-406/{bytes.mli => bytes.resi} | 313 ++++---- jscomp/stdlib-406/bytesLabels.ml | 428 ---------- jscomp/stdlib-406/bytesLabels.mli | 276 ------- jscomp/stdlib-406/bytesLabels.res | Bin 0 -> 13251 bytes jscomp/stdlib-406/bytesLabels.resi | 271 +++++++ jscomp/stdlib-406/callback.ml | 20 - jscomp/stdlib-406/callback.mli | 34 - jscomp/stdlib-406/callback.res | 19 + jscomp/stdlib-406/callback.resi | 34 + jscomp/stdlib-406/camlinternalLazy.ml | 88 -- jscomp/stdlib-406/camlinternalLazy.mli | 27 - jscomp/stdlib-406/camlinternalLazy.res | 92 +++ jscomp/stdlib-406/camlinternalLazy.resi | 27 + jscomp/stdlib-406/camlinternalMod.ml | 21 - jscomp/stdlib-406/camlinternalMod.mli | 25 - jscomp/stdlib-406/camlinternalMod.res | 21 + jscomp/stdlib-406/camlinternalMod.resi | 25 + jscomp/stdlib-406/char.ml | 76 -- jscomp/stdlib-406/char.mli | 72 -- jscomp/stdlib-406/char.res | 85 ++ jscomp/stdlib-406/char.resi | 74 ++ jscomp/stdlib-406/complex.ml | 87 -- jscomp/stdlib-406/complex.mli | 86 -- jscomp/stdlib-406/complex.res | 112 +++ jscomp/stdlib-406/complex.resi | 86 ++ jscomp/stdlib-406/digest.ml | 66 -- jscomp/stdlib-406/digest.mli | 68 -- jscomp/stdlib-406/digest.res | 78 ++ jscomp/stdlib-406/digest.resi | 67 ++ jscomp/stdlib-406/filename.ml | 233 ------ jscomp/stdlib-406/filename.mli | 134 ---- jscomp/stdlib-406/filename.res | 353 ++++++++ jscomp/stdlib-406/filename.resi | 134 ++++ jscomp/stdlib-406/genlex.ml | 201 ----- jscomp/stdlib-406/genlex.mli | 73 -- jscomp/stdlib-406/genlex.res | 353 ++++++++ jscomp/stdlib-406/genlex.resi | 73 ++ jscomp/stdlib-406/hashtbl.ml | 541 ------------- jscomp/stdlib-406/hashtbl.res | 679 ++++++++++++++++ .../stdlib-406/{hashtbl.mli => hashtbl.resi} | 375 +++++---- jscomp/stdlib-406/hashtblLabels.ml | 130 --- jscomp/stdlib-406/hashtblLabels.res | 129 +++ jscomp/stdlib-406/int32.ml | 64 -- jscomp/stdlib-406/int32.mli | 186 ----- jscomp/stdlib-406/int32.res | 64 ++ jscomp/stdlib-406/int32.resi | 178 +++++ jscomp/stdlib-406/int64.ml | 72 -- jscomp/stdlib-406/int64.mli | 197 ----- jscomp/stdlib-406/int64.res | 71 ++ jscomp/stdlib-406/int64.resi | 191 +++++ jscomp/stdlib-406/lazy.ml | 70 -- jscomp/stdlib-406/lazy.mli | 95 --- jscomp/stdlib-406/lazy.res | 68 ++ jscomp/stdlib-406/lazy.resi | 93 +++ jscomp/stdlib-406/lexing.ml | 230 ------ jscomp/stdlib-406/lexing.mli | 172 ---- jscomp/stdlib-406/lexing.res | 245 ++++++ jscomp/stdlib-406/lexing.resi | 170 ++++ jscomp/stdlib-406/list.ml | 485 ----------- jscomp/stdlib-406/list.mli | 347 -------- jscomp/stdlib-406/list.res | 751 ++++++++++++++++++ jscomp/stdlib-406/list.resi | 333 ++++++++ jscomp/stdlib-406/listLabels.ml | 485 ----------- jscomp/stdlib-406/listLabels.mli | 353 -------- jscomp/stdlib-406/listLabels.res | 751 ++++++++++++++++++ jscomp/stdlib-406/listLabels.resi | 337 ++++++++ jscomp/stdlib-406/map.ml | 480 ----------- jscomp/stdlib-406/map.res | 669 ++++++++++++++++ jscomp/stdlib-406/{map.mli => map.resi} | 277 ++++--- jscomp/stdlib-406/mapLabels.ml | 480 ----------- jscomp/stdlib-406/mapLabels.res | 669 ++++++++++++++++ jscomp/stdlib-406/moreLabels.ml | 22 - jscomp/stdlib-406/moreLabels.mli | 198 ----- jscomp/stdlib-406/moreLabels.res | 22 + jscomp/stdlib-406/moreLabels.resi | 182 +++++ jscomp/stdlib-406/obj.ml | 29 - jscomp/stdlib-406/obj.mli | 57 -- jscomp/stdlib-406/obj.res | 29 + jscomp/stdlib-406/obj.resi | 52 ++ jscomp/stdlib-406/parsing.ml | 212 ----- jscomp/stdlib-406/parsing.mli | 105 --- jscomp/stdlib-406/parsing.res | 232 ++++++ jscomp/stdlib-406/parsing.resi | 107 +++ jscomp/stdlib-406/queue.ml | 132 --- jscomp/stdlib-406/queue.mli | 82 -- jscomp/stdlib-406/queue.res | 142 ++++ jscomp/stdlib-406/queue.resi | 80 ++ jscomp/stdlib-406/random.ml | 273 ------- jscomp/stdlib-406/random.mli | 102 --- jscomp/stdlib-406/random.res | 336 ++++++++ jscomp/stdlib-406/random.resi | 102 +++ jscomp/stdlib-406/release.ninja | 146 ++-- jscomp/stdlib-406/set.ml | 526 ------------ jscomp/stdlib-406/set.mli | 266 ------- jscomp/stdlib-406/set.res | 711 +++++++++++++++++ jscomp/stdlib-406/set.resi | 264 ++++++ jscomp/stdlib-406/setLabels.ml | 526 ------------ jscomp/stdlib-406/setLabels.res | 711 +++++++++++++++++ jscomp/stdlib-406/sort.ml | 99 --- jscomp/stdlib-406/sort.mli | 44 - jscomp/stdlib-406/sort.res | 134 ++++ jscomp/stdlib-406/sort.resi | 44 + jscomp/stdlib-406/stack.ml | 44 - jscomp/stdlib-406/stack.mli | 63 -- jscomp/stdlib-406/stack.res | 55 ++ jscomp/stdlib-406/stack.resi | 62 ++ jscomp/stdlib-406/stdLabels.ml | 24 - jscomp/stdlib-406/stdLabels.mli | 29 - jscomp/stdlib-406/stdLabels.res | 24 + jscomp/stdlib-406/stdLabels.resi | 29 + jscomp/stdlib-406/stream.ml | 213 ----- jscomp/stdlib-406/stream.mli | 108 --- jscomp/stdlib-406/stream.res | 260 ++++++ jscomp/stdlib-406/stream.resi | 105 +++ jscomp/stdlib-406/string.ml | 190 ----- jscomp/stdlib-406/string.res | 235 ++++++ jscomp/stdlib-406/{string.mli => string.resi} | 234 +++--- jscomp/stdlib-406/stringLabels.ml | 190 ----- jscomp/stdlib-406/stringLabels.mli | 241 ------ jscomp/stdlib-406/stringLabels.res | 235 ++++++ jscomp/stdlib-406/stringLabels.resi | 237 ++++++ jscomp/stdlib-406/sys.ml | 135 ---- jscomp/stdlib-406/sys.mli | 333 -------- jscomp/stdlib-406/sys.res | 131 +++ jscomp/stdlib-406/sys.resi | 324 ++++++++ jscomp/stdlib-406/uchar.ml | 58 -- jscomp/stdlib-406/uchar.mli | 98 --- jscomp/stdlib-406/uchar.res | 74 ++ jscomp/stdlib-406/uchar.resi | 98 +++ lib/es6/array.js | 20 +- lib/es6/arrayLabels.js | 20 +- lib/es6/buffer.js | 40 +- lib/es6/bytes.js | 16 +- lib/es6/bytesLabels.js | 16 +- lib/es6/camlinternalLazy.js | 2 +- lib/es6/char.js | 24 +- lib/es6/hashtbl.js | 142 ++-- lib/es6/list.js | 4 +- lib/es6/listLabels.js | 4 +- lib/es6/map.js | 76 +- lib/es6/mapLabels.js | 76 +- lib/es6/moreLabels.js | 136 ++-- lib/es6/set.js | 60 +- lib/es6/setLabels.js | 60 +- lib/es6/sort.js | 24 +- lib/es6/stream.js | 34 +- lib/js/array.js | 20 +- lib/js/arrayLabels.js | 20 +- lib/js/buffer.js | 40 +- lib/js/bytes.js | 16 +- lib/js/bytesLabels.js | 16 +- lib/js/camlinternalLazy.js | 2 +- lib/js/char.js | 24 +- lib/js/hashtbl.js | 142 ++-- lib/js/list.js | 4 +- lib/js/listLabels.js | 4 +- lib/js/map.js | 76 +- lib/js/mapLabels.js | 76 +- lib/js/moreLabels.js | 136 ++-- lib/js/set.js | 60 +- lib/js/setLabels.js | 60 +- lib/js/sort.js | 24 +- lib/js/stream.js | 34 +- 177 files changed, 15546 insertions(+), 14232 deletions(-) delete mode 100644 jscomp/stdlib-406/array.ml delete mode 100644 jscomp/stdlib-406/array.mli create mode 100644 jscomp/stdlib-406/array.res create mode 100644 jscomp/stdlib-406/array.resi delete mode 100644 jscomp/stdlib-406/arrayLabels.ml delete mode 100644 jscomp/stdlib-406/arrayLabels.mli create mode 100644 jscomp/stdlib-406/arrayLabels.res create mode 100644 jscomp/stdlib-406/arrayLabels.resi delete mode 100644 jscomp/stdlib-406/buffer.ml delete mode 100644 jscomp/stdlib-406/buffer.mli create mode 100644 jscomp/stdlib-406/buffer.res create mode 100644 jscomp/stdlib-406/buffer.resi delete mode 100644 jscomp/stdlib-406/bytes.ml create mode 100644 jscomp/stdlib-406/bytes.res rename jscomp/stdlib-406/{bytes.mli => bytes.resi} (57%) delete mode 100644 jscomp/stdlib-406/bytesLabels.ml delete mode 100644 jscomp/stdlib-406/bytesLabels.mli create mode 100644 jscomp/stdlib-406/bytesLabels.res create mode 100644 jscomp/stdlib-406/bytesLabels.resi delete mode 100644 jscomp/stdlib-406/callback.ml delete mode 100644 jscomp/stdlib-406/callback.mli create mode 100644 jscomp/stdlib-406/callback.res create mode 100644 jscomp/stdlib-406/callback.resi delete mode 100644 jscomp/stdlib-406/camlinternalLazy.ml delete mode 100644 jscomp/stdlib-406/camlinternalLazy.mli create mode 100644 jscomp/stdlib-406/camlinternalLazy.res create mode 100644 jscomp/stdlib-406/camlinternalLazy.resi delete mode 100644 jscomp/stdlib-406/camlinternalMod.ml delete mode 100644 jscomp/stdlib-406/camlinternalMod.mli create mode 100644 jscomp/stdlib-406/camlinternalMod.res create mode 100644 jscomp/stdlib-406/camlinternalMod.resi delete mode 100644 jscomp/stdlib-406/char.ml delete mode 100644 jscomp/stdlib-406/char.mli create mode 100644 jscomp/stdlib-406/char.res create mode 100644 jscomp/stdlib-406/char.resi delete mode 100644 jscomp/stdlib-406/complex.ml delete mode 100644 jscomp/stdlib-406/complex.mli create mode 100644 jscomp/stdlib-406/complex.res create mode 100644 jscomp/stdlib-406/complex.resi delete mode 100644 jscomp/stdlib-406/digest.ml delete mode 100644 jscomp/stdlib-406/digest.mli create mode 100644 jscomp/stdlib-406/digest.res create mode 100644 jscomp/stdlib-406/digest.resi delete mode 100644 jscomp/stdlib-406/filename.ml delete mode 100644 jscomp/stdlib-406/filename.mli create mode 100644 jscomp/stdlib-406/filename.res create mode 100644 jscomp/stdlib-406/filename.resi delete mode 100644 jscomp/stdlib-406/genlex.ml delete mode 100644 jscomp/stdlib-406/genlex.mli create mode 100644 jscomp/stdlib-406/genlex.res create mode 100644 jscomp/stdlib-406/genlex.resi delete mode 100644 jscomp/stdlib-406/hashtbl.ml create mode 100644 jscomp/stdlib-406/hashtbl.res rename jscomp/stdlib-406/{hashtbl.mli => hashtbl.resi} (56%) delete mode 100644 jscomp/stdlib-406/hashtblLabels.ml create mode 100644 jscomp/stdlib-406/hashtblLabels.res delete mode 100644 jscomp/stdlib-406/int32.ml delete mode 100644 jscomp/stdlib-406/int32.mli create mode 100644 jscomp/stdlib-406/int32.res create mode 100644 jscomp/stdlib-406/int32.resi delete mode 100644 jscomp/stdlib-406/int64.ml delete mode 100644 jscomp/stdlib-406/int64.mli create mode 100644 jscomp/stdlib-406/int64.res create mode 100644 jscomp/stdlib-406/int64.resi delete mode 100644 jscomp/stdlib-406/lazy.ml delete mode 100644 jscomp/stdlib-406/lazy.mli create mode 100644 jscomp/stdlib-406/lazy.res create mode 100644 jscomp/stdlib-406/lazy.resi delete mode 100644 jscomp/stdlib-406/lexing.ml delete mode 100644 jscomp/stdlib-406/lexing.mli create mode 100644 jscomp/stdlib-406/lexing.res create mode 100644 jscomp/stdlib-406/lexing.resi delete mode 100644 jscomp/stdlib-406/list.ml delete mode 100644 jscomp/stdlib-406/list.mli create mode 100644 jscomp/stdlib-406/list.res create mode 100644 jscomp/stdlib-406/list.resi delete mode 100644 jscomp/stdlib-406/listLabels.ml delete mode 100644 jscomp/stdlib-406/listLabels.mli create mode 100644 jscomp/stdlib-406/listLabels.res create mode 100644 jscomp/stdlib-406/listLabels.resi delete mode 100644 jscomp/stdlib-406/map.ml create mode 100644 jscomp/stdlib-406/map.res rename jscomp/stdlib-406/{map.mli => map.resi} (50%) delete mode 100644 jscomp/stdlib-406/mapLabels.ml create mode 100644 jscomp/stdlib-406/mapLabels.res delete mode 100644 jscomp/stdlib-406/moreLabels.ml delete mode 100644 jscomp/stdlib-406/moreLabels.mli create mode 100644 jscomp/stdlib-406/moreLabels.res create mode 100644 jscomp/stdlib-406/moreLabels.resi delete mode 100644 jscomp/stdlib-406/obj.ml delete mode 100644 jscomp/stdlib-406/obj.mli create mode 100644 jscomp/stdlib-406/obj.res create mode 100644 jscomp/stdlib-406/obj.resi delete mode 100644 jscomp/stdlib-406/parsing.ml delete mode 100644 jscomp/stdlib-406/parsing.mli create mode 100644 jscomp/stdlib-406/parsing.res create mode 100644 jscomp/stdlib-406/parsing.resi delete mode 100644 jscomp/stdlib-406/queue.ml delete mode 100644 jscomp/stdlib-406/queue.mli create mode 100644 jscomp/stdlib-406/queue.res create mode 100644 jscomp/stdlib-406/queue.resi delete mode 100644 jscomp/stdlib-406/random.ml delete mode 100644 jscomp/stdlib-406/random.mli create mode 100644 jscomp/stdlib-406/random.res create mode 100644 jscomp/stdlib-406/random.resi delete mode 100644 jscomp/stdlib-406/set.ml delete mode 100644 jscomp/stdlib-406/set.mli create mode 100644 jscomp/stdlib-406/set.res create mode 100644 jscomp/stdlib-406/set.resi delete mode 100644 jscomp/stdlib-406/setLabels.ml create mode 100644 jscomp/stdlib-406/setLabels.res delete mode 100644 jscomp/stdlib-406/sort.ml delete mode 100644 jscomp/stdlib-406/sort.mli create mode 100644 jscomp/stdlib-406/sort.res create mode 100644 jscomp/stdlib-406/sort.resi delete mode 100644 jscomp/stdlib-406/stack.ml delete mode 100644 jscomp/stdlib-406/stack.mli create mode 100644 jscomp/stdlib-406/stack.res create mode 100644 jscomp/stdlib-406/stack.resi delete mode 100644 jscomp/stdlib-406/stdLabels.ml delete mode 100644 jscomp/stdlib-406/stdLabels.mli create mode 100644 jscomp/stdlib-406/stdLabels.res create mode 100644 jscomp/stdlib-406/stdLabels.resi delete mode 100644 jscomp/stdlib-406/stream.ml delete mode 100644 jscomp/stdlib-406/stream.mli create mode 100644 jscomp/stdlib-406/stream.res create mode 100644 jscomp/stdlib-406/stream.resi delete mode 100644 jscomp/stdlib-406/string.ml create mode 100644 jscomp/stdlib-406/string.res rename jscomp/stdlib-406/{string.mli => string.resi} (52%) delete mode 100644 jscomp/stdlib-406/stringLabels.ml delete mode 100644 jscomp/stdlib-406/stringLabels.mli create mode 100644 jscomp/stdlib-406/stringLabels.res create mode 100644 jscomp/stdlib-406/stringLabels.resi delete mode 100644 jscomp/stdlib-406/sys.ml delete mode 100644 jscomp/stdlib-406/sys.mli create mode 100644 jscomp/stdlib-406/sys.res create mode 100644 jscomp/stdlib-406/sys.resi delete mode 100644 jscomp/stdlib-406/uchar.ml delete mode 100644 jscomp/stdlib-406/uchar.mli create mode 100644 jscomp/stdlib-406/uchar.res create mode 100644 jscomp/stdlib-406/uchar.resi diff --git a/jscomp/stdlib-406/array.ml b/jscomp/stdlib-406/array.ml deleted file mode 100644 index 34f42e964e..0000000000 --- a/jscomp/stdlib-406/array.ml +++ /dev/null @@ -1,307 +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. *) -(* *) -(**************************************************************************) - -(* Array operations *) - -external length : 'a array -> int = "%array_length" -external get: 'a array -> int -> 'a = "%array_safe_get" -external set: 'a array -> int -> 'a -> unit = "%array_safe_set" -external unsafe_get: 'a array -> int -> 'a = "%array_unsafe_get" -external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set" -external make: int -> 'a -> 'a array = "?make_vect" -external create: int -> 'a -> 'a array = "?make_vect" -external unsafe_sub : 'a array -> int -> int -> 'a array = "?array_sub" - -external append_prim : 'a array -> 'a array -> 'a array = "concat" -[@@send] - -external concat : 'a array list -> 'a array = "?array_concat" -external unsafe_blit : - 'a array -> int -> 'a array -> int -> int -> unit = "?array_blit" -external create_float: int -> float array = "?make_float_vect" -let make_float = create_float - -module Floatarray = struct - external create : int -> floatarray = "?floatarray_create" - external length : floatarray -> int = "%floatarray_length" - external get : floatarray -> int -> float = "%floatarray_safe_get" - external set : floatarray -> int -> float -> unit = "%floatarray_safe_set" - external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get" - external unsafe_set : floatarray -> int -> float -> unit - = "%floatarray_unsafe_set" -end - -let init l f = - if l = 0 then [||] else - if l < 0 then invalid_arg "Array.init" - (* See #6575. We could also check for maximum array size, but this depends - on whether we create a float array or a regular one... *) - else - let res = create l (f 0) in - for i = 1 to pred l do - unsafe_set res i (f i) - done; - res - -let make_matrix sx sy init = - let res = create sx [||] in - for x = 0 to pred sx do - unsafe_set res x (create sy init) - done; - res - -let create_matrix = make_matrix - -let copy a = - let l = length a in if l = 0 then [||] else unsafe_sub a 0 l - -let append a1 a2 = - let l1 = length a1 in - if l1 = 0 then copy a2 - else if length a2 = 0 then unsafe_sub a1 0 l1 - else append_prim a1 a2 - -let sub a ofs len = - if ofs < 0 || len < 0 || ofs > length a - len - then invalid_arg "Array.sub" - else unsafe_sub a ofs len - -let fill a ofs len v = - if ofs < 0 || len < 0 || ofs > length a - len - then invalid_arg "Array.fill" - else for i = ofs to ofs + len - 1 do unsafe_set a i v done - -let blit a1 ofs1 a2 ofs2 len = - if len < 0 || ofs1 < 0 || ofs1 > length a1 - len - || ofs2 < 0 || ofs2 > length a2 - len - then invalid_arg "Array.blit" - else unsafe_blit a1 ofs1 a2 ofs2 len - -let iter f a = - for i = 0 to length a - 1 do f(unsafe_get a i) done - -let iter2 f a b = - if length a <> length b then - invalid_arg "Array.iter2: arrays must have the same length" - else - for i = 0 to length a - 1 do f (unsafe_get a i) (unsafe_get b i) done - -let map f a = - let l = length a in - if l = 0 then [||] else begin - let r = create l (f(unsafe_get a 0)) in - for i = 1 to l - 1 do - unsafe_set r i (f(unsafe_get a i)) - done; - r - end - -let map2 f a b = - let la = length a in - let lb = length b in - if la <> lb then - invalid_arg "Array.map2: arrays must have the same length" - else begin - if la = 0 then [||] else begin - let r = create la (f (unsafe_get a 0) (unsafe_get b 0)) in - for i = 1 to la - 1 do - unsafe_set r i (f (unsafe_get a i) (unsafe_get b i)) - done; - r - end - end - -let iteri f a = - for i = 0 to length a - 1 do f i (unsafe_get a i) done - -let mapi f a = - let l = length a in - if l = 0 then [||] else begin - let r = create l (f 0 (unsafe_get a 0)) in - for i = 1 to l - 1 do - unsafe_set r i (f i (unsafe_get a i)) - done; - r - end - -let to_list a = - let rec tolist i res = - if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in - tolist (length a - 1) [] - -(* Cannot use List.length here because the List module depends on Array. *) -let rec list_length accu = function - | [] -> accu - | _::t -> list_length (succ accu) t - -let of_list = function - [] -> [||] - | hd::tl as l -> - let a = create (list_length 0 l) hd in - let rec fill i = function - [] -> a - | hd::tl -> unsafe_set a i hd; fill (i+1) tl in - fill 1 tl - -let fold_left f x a = - let r = ref x in - for i = 0 to length a - 1 do - r := f !r (unsafe_get a i) - done; - !r - -let fold_right f a x = - let r = ref x in - for i = length a - 1 downto 0 do - r := f (unsafe_get a i) !r - done; - !r - -let exists p a = - let n = length a in - let rec loop i = - if i = n then false - else if p (unsafe_get a i) then true - else loop (succ i) in - loop 0 - -let for_all p a = - let n = length a in - let rec loop i = - if i = n then true - else if p (unsafe_get a i) then loop (succ i) - else false in - loop 0 - -let mem x a = - let n = length a in - let rec loop i = - if i = n then false - else if compare (unsafe_get a i) x = 0 then true - else loop (succ i) in - loop 0 - -let memq x a = - let n = length a in - let rec loop i = - if i = n then false - else if x == (unsafe_get a i) then true - else loop (succ i) in - loop 0 - -exception Bottom of int -let sort cmp a = - let maxson l i = - let i31 = i+i+i+1 in - let x = ref i31 in - if i31+2 < l then begin - if cmp (get a i31) (get a (i31+1)) < 0 then x := i31+1; - if cmp (get a !x) (get a (i31+2)) < 0 then x := i31+2; - !x - end else - if i31+1 < l && cmp (get a i31) (get a (i31+1)) < 0 - then i31+1 - else if i31 < l then i31 else raise (Bottom i) - in - let rec trickledown l i e = - let j = maxson l i in - if cmp (get a j) e > 0 then begin - set a i (get a j); - trickledown l j e; - end else begin - set a i e; - end; - in - let trickle l i e = try trickledown l i e with Bottom i -> set a i e in - let rec bubbledown l i = - let j = maxson l i in - set a i (get a j); - bubbledown l j - in - let bubble l i = try bubbledown l i with Bottom i -> i in - let rec trickleup i e = - let father = (i - 1) / 3 in - assert (i <> father); - if cmp (get a father) e < 0 then begin - set a i (get a father); - if father > 0 then trickleup father e else set a 0 e; - end else begin - set a i e; - end; - in - let l = length a in - for i = (l + 1) / 3 - 1 downto 0 do trickle l i (get a i); done; - for i = l - 1 downto 2 do - let e = (get a i) in - set a i (get a 0); - trickleup (bubble i 0) e; - done; - if l > 1 then (let e = (get a 1) in set a 1 (get a 0); set a 0 e) - - -let cutoff = 5 -let stable_sort cmp a = - let merge src1ofs src1len src2 src2ofs src2len dst dstofs = - let src1r = src1ofs + src1len and src2r = src2ofs + src2len in - let rec loop i1 s1 i2 s2 d = - if cmp s1 s2 <= 0 then begin - set dst d s1; - let i1 = i1 + 1 in - if i1 < src1r then - loop i1 (get a i1) i2 s2 (d + 1) - else - blit src2 i2 dst (d + 1) (src2r - i2) - end else begin - set dst d s2; - let i2 = i2 + 1 in - if i2 < src2r then - loop i1 s1 i2 (get src2 i2) (d + 1) - else - blit a i1 dst (d + 1) (src1r - i1) - end - in loop src1ofs (get a src1ofs) src2ofs (get src2 src2ofs) dstofs; - in - let isortto srcofs dst dstofs len = - for i = 0 to len - 1 do - let e = (get a (srcofs + i)) in - let j = ref (dstofs + i - 1) in - while (!j >= dstofs && cmp (get dst !j) e > 0) do - set dst (!j + 1) (get dst !j); - decr j; - done; - set dst (!j + 1) e; - done; - in - let rec sortto srcofs dst dstofs len = - if len <= cutoff then isortto srcofs dst dstofs len else begin - let l1 = len / 2 in - let l2 = len - l1 in - sortto (srcofs + l1) dst (dstofs + l1) l2; - sortto srcofs a (srcofs + l2) l1; - merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs; - end; - in - let l = length a in - if l <= cutoff then isortto 0 a 0 l else begin - let l1 = l / 2 in - let l2 = l - l1 in - let t = make l2 (get a 0) in - sortto l1 t 0 l2; - sortto 0 a l2 l1; - merge l2 l1 t 0 l2 a 0; - end - - -let fast_sort = stable_sort diff --git a/jscomp/stdlib-406/array.mli b/jscomp/stdlib-406/array.mli deleted file mode 100644 index ee5c6997d5..0000000000 --- a/jscomp/stdlib-406/array.mli +++ /dev/null @@ -1,275 +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. *) -(* *) -(**************************************************************************) - -(** Array operations. *) - -external length : 'a array -> int = "%array_length" -(** Return the length (number of elements) of the given array. *) - -external get : 'a array -> int -> 'a = "%array_safe_get" -(** [Array.get a n] returns the element number [n] of array [a]. - The first element has number 0. - The last element has number [Array.length a - 1]. - You can also write [a.(n)] instead of [Array.get a n]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [(Array.length a - 1)]. *) - -external set : 'a array -> int -> 'a -> unit = "%array_safe_set" -(** [Array.set a n x] modifies array [a] in place, replacing - element number [n] with [x]. - You can also write [a.(n) <- x] instead of [Array.set a n x]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [Array.length a - 1]. *) - -external make : int -> 'a -> 'a array = "?make_vect" -(** [Array.make n x] returns a fresh array of length [n], - initialized with [x]. - All the elements of this new array are initially - physically equal to [x] (in the sense of the [==] predicate). - Consequently, if [x] is mutable, it is shared among all elements - of the array, and modifying [x] through one of the array entries - will modify all other entries at the same time. - - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. - If the value of [x] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2].*) - -external create : int -> 'a -> 'a array = "?make_vect" - [@@ocaml.deprecated "Use Array.make instead."] -(** @deprecated [Array.create] is an alias for {!Array.make}. *) - -external create_float: int -> float array = "?make_float_vect" -(** [Array.create_float n] returns a fresh float array of length [n], - with uninitialized data. - @since 4.03 *) - -val make_float: int -> float array - [@@ocaml.deprecated "Use Array.create_float instead."] -(** @deprecated [Array.make_float] is an alias for {!Array.create_float}. *) - -val init : int -> (int -> 'a) -> 'a array -(** [Array.init n f] returns a fresh array of length [n], - with element number [i] initialized to the result of [f i]. - In other terms, [Array.init n f] tabulates the results of [f] - applied to the integers [0] to [n-1]. - - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. - If the return type of [f] is [float], then the maximum - size is only [Sys.max_array_length / 2].*) - -val make_matrix : int -> int -> 'a -> 'a array array -(** [Array.make_matrix dimx dimy e] returns a two-dimensional array - (an array of arrays) with first dimension [dimx] and - second dimension [dimy]. All the elements of this new matrix - are initially physically equal to [e]. - The element ([x,y]) of a matrix [m] is accessed - with the notation [m.(x).(y)]. - - Raise [Invalid_argument] if [dimx] or [dimy] is negative or - greater than {!Sys.max_array_length}. - If the value of [e] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2]. *) - -val create_matrix : int -> int -> 'a -> 'a array array - [@@ocaml.deprecated "Use Array.make_matrix instead."] -(** @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. *) - -val append : 'a array -> 'a array -> 'a array -(** [Array.append v1 v2] returns a fresh array containing the - concatenation of the arrays [v1] and [v2]. *) - -val concat : 'a array list -> 'a array -(** Same as {!Array.append}, but concatenates a list of arrays. *) - -val sub : 'a array -> int -> int -> 'a array -(** [Array.sub a start len] returns a fresh array of length [len], - containing the elements number [start] to [start + len - 1] - of array [a]. - - Raise [Invalid_argument "Array.sub"] if [start] and [len] do not - designate a valid subarray of [a]; that is, if - [start < 0], or [len < 0], or [start + len > Array.length a]. *) - -val copy : 'a array -> 'a array -(** [Array.copy a] returns a copy of [a], that is, a fresh array - containing the same elements as [a]. *) - -val fill : 'a array -> int -> int -> 'a -> unit -(** [Array.fill a ofs len x] modifies the array [a] in place, - storing [x] in elements number [ofs] to [ofs + len - 1]. - - Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not - designate a valid subarray of [a]. *) - -val blit : 'a array -> int -> 'a array -> int -> int -> unit -(** [Array.blit v1 o1 v2 o2 len] copies [len] elements - from array [v1], starting at element number [o1], to array [v2], - starting at element number [o2]. It works correctly even if - [v1] and [v2] are the same array, and the source and - destination chunks overlap. - - Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not - designate a valid subarray of [v1], or if [o2] and [len] do not - designate a valid subarray of [v2]. *) - -val to_list : 'a array -> 'a list -(** [Array.to_list a] returns the list of all the elements of [a]. *) - -val of_list : 'a list -> 'a array -(** [Array.of_list l] returns a fresh array containing the elements - of [l]. *) - - -(** {1 Iterators} *) - - -val iter : ('a -> unit) -> 'a array -> unit -(** [Array.iter f a] applies function [f] in turn to all - the elements of [a]. It is equivalent to - [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) - -val iteri : (int -> 'a -> unit) -> 'a array -> unit -(** Same as {!Array.iter}, but the - function is applied with the index of the element as first argument, - and the element itself as second argument. *) - -val map : ('a -> 'b) -> 'a array -> 'b array -(** [Array.map f a] applies function [f] to all the elements of [a], - and builds an array with the results returned by [f]: - [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) - -val mapi : (int -> 'a -> 'b) -> 'a array -> 'b array -(** Same as {!Array.map}, but the - function is applied to the index of the element as first argument, - and the element itself as second argument. *) - -val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a -(** [Array.fold_left f x a] computes - [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], - where [n] is the length of the array [a]. *) - -val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a -(** [Array.fold_right f a x] computes - [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], - where [n] is the length of the array [a]. *) - - -(** {1 Iterators on two arrays} *) - - -val iter2 : ('a -> 'b -> unit) -> 'a array -> 'b array -> unit -(** [Array.iter2 f a b] applies function [f] to all the elements of [a] - and [b]. - Raise [Invalid_argument] if the arrays are not the same size. - @since 4.03.0 *) - -val map2 : ('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array -(** [Array.map2 f a b] applies function [f] to all the elements of [a] - and [b], and builds an array with the results returned by [f]: - [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. - Raise [Invalid_argument] if the arrays are not the same size. - @since 4.03.0 *) - - -(** {1 Array scanning} *) - - -val for_all : ('a -> bool) -> 'a array -> bool -(** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. - @since 4.03.0 *) - -val exists : ('a -> bool) -> 'a array -> bool -(** [Array.exists p [|a1; ...; an|]] checks if at least one element of - the array satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. - @since 4.03.0 *) - -val mem : 'a -> 'a array -> bool -(** [mem a l] is true if and only if [a] is equal - to an element of [l]. - @since 4.03.0 *) - -val memq : 'a -> 'a array -> bool -(** Same as {!Array.mem}, but uses physical equality instead of structural - equality to compare array elements. - @since 4.03.0 *) - - -(** {1 Sorting} *) - - -val sort : ('a -> 'a -> int) -> 'a array -> unit -(** Sort an array in increasing order according to a comparison - function. The comparison function must return 0 if its arguments - compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller (see below for a - complete specification). For example, {!Pervasives.compare} is - a suitable comparison function, provided there are no floating-point - NaN values in the data. After calling [Array.sort], the - array is sorted in place in increasing order. - [Array.sort] is guaranteed to run in constant heap space - and (at most) logarithmic stack space. - - The current implementation uses Heap Sort. It runs in constant - stack space. - - Specification of the comparison function: - Let [a] be the array and [cmp] the comparison function. The following - must be true for all x, y, z in a : -- [cmp x y] > 0 if and only if [cmp y x] < 0 -- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 - - When [Array.sort] returns, [a] contains the same elements as before, - reordered in such a way that for all i and j valid indices of [a] : -- [cmp a.(i) a.(j)] >= 0 if and only if i >= j -*) - -val stable_sort : ('a -> 'a -> int) -> 'a array -> unit -(** Same as {!Array.sort}, but the sorting algorithm is stable (i.e. - elements that compare equal are kept in their original order) and - not guaranteed to run in constant heap space. - - The current implementation uses Merge Sort. It uses [n/2] - words of heap space, where [n] is the length of the array. - It is usually faster than the current implementation of {!Array.sort}. -*) - -val fast_sort : ('a -> 'a -> int) -> 'a array -> unit -(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster - on typical input. -*) - - -(**/**) -(** {1 Undocumented functions} *) - -(* The following is for system use only. Do not call directly. *) - -external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" -external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" - -module Floatarray : sig - external create : int -> floatarray = "?floatarray_create" - external length : floatarray -> int = "%floatarray_length" - external get : floatarray -> int -> float = "%floatarray_safe_get" - external set : floatarray -> int -> float -> unit = "%floatarray_safe_set" - external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get" - external unsafe_set : floatarray -> int -> float -> unit - = "%floatarray_unsafe_set" -end diff --git a/jscomp/stdlib-406/array.res b/jscomp/stdlib-406/array.res new file mode 100644 index 0000000000..486217b151 --- /dev/null +++ b/jscomp/stdlib-406/array.res @@ -0,0 +1,410 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Array operations */ + +external length: array<'a> => int = "%array_length" +external get: (array<'a>, int) => 'a = "%array_safe_get" +external set: (array<'a>, int, 'a) => unit = "%array_safe_set" +external unsafe_get: (array<'a>, int) => 'a = "%array_unsafe_get" +external unsafe_set: (array<'a>, int, 'a) => unit = "%array_unsafe_set" +external make: (int, 'a) => array<'a> = "?make_vect" +external create: (int, 'a) => array<'a> = "?make_vect" +external unsafe_sub: (array<'a>, int, int) => array<'a> = "?array_sub" + +@send external append_prim: (array<'a>, array<'a>) => array<'a> = "concat" + +external concat: list> => array<'a> = "?array_concat" +external unsafe_blit: (array<'a>, int, array<'a>, int, int) => unit = "?array_blit" +external create_float: int => array = "?make_float_vect" +let make_float = create_float + +module Floatarray = { + external create: int => floatarray = "?floatarray_create" + external length: floatarray => int = "%floatarray_length" + external get: (floatarray, int) => float = "%floatarray_safe_get" + external set: (floatarray, int, float) => unit = "%floatarray_safe_set" + external unsafe_get: (floatarray, int) => float = "%floatarray_unsafe_get" + external unsafe_set: (floatarray, int, float) => unit = "%floatarray_unsafe_set" +} + +let init = (l, f) => + if l == 0 { + [] + } else if l < 0 { + invalid_arg("Array.init") + } else { + /* See #6575. We could also check for maximum array size, but this depends + on whether we create a float array or a regular one... */ + + let res = create(l, f(0)) + for i in 1 to pred(l) { + unsafe_set(res, i, f(i)) + } + res + } + +let make_matrix = (sx, sy, init) => { + let res = create(sx, []) + for x in 0 to pred(sx) { + unsafe_set(res, x, create(sy, init)) + } + res +} + +let create_matrix = make_matrix + +let copy = a => { + let l = length(a) + if l == 0 { + [] + } else { + unsafe_sub(a, 0, l) + } +} + +let append = (a1, a2) => { + let l1 = length(a1) + if l1 == 0 { + copy(a2) + } else if length(a2) == 0 { + unsafe_sub(a1, 0, l1) + } else { + append_prim(a1, a2) + } +} + +let sub = (a, ofs, len) => + if ofs < 0 || (len < 0 || ofs > length(a) - len) { + invalid_arg("Array.sub") + } else { + unsafe_sub(a, ofs, len) + } + +let fill = (a, ofs, len, v) => + if ofs < 0 || (len < 0 || ofs > length(a) - len) { + invalid_arg("Array.fill") + } else { + for i in ofs to ofs + len - 1 { + unsafe_set(a, i, v) + } + } + +let blit = (a1, ofs1, a2, ofs2, len) => + if len < 0 || (ofs1 < 0 || (ofs1 > length(a1) - len || (ofs2 < 0 || ofs2 > length(a2) - len))) { + invalid_arg("Array.blit") + } else { + unsafe_blit(a1, ofs1, a2, ofs2, len) + } + +let iter = (f, a) => + for i in 0 to length(a) - 1 { + f(unsafe_get(a, i)) + } + +let iter2 = (f, a, b) => + if length(a) != length(b) { + invalid_arg("Array.iter2: arrays must have the same length") + } else { + for i in 0 to length(a) - 1 { + f(unsafe_get(a, i), unsafe_get(b, i)) + } + } + +let map = (f, a) => { + let l = length(a) + if l == 0 { + [] + } else { + let r = create(l, f(unsafe_get(a, 0))) + for i in 1 to l - 1 { + unsafe_set(r, i, f(unsafe_get(a, i))) + } + r + } +} + +let map2 = (f, a, b) => { + let la = length(a) + let lb = length(b) + if la != lb { + invalid_arg("Array.map2: arrays must have the same length") + } else if la == 0 { + [] + } else { + let r = create(la, f(unsafe_get(a, 0), unsafe_get(b, 0))) + for i in 1 to la - 1 { + unsafe_set(r, i, f(unsafe_get(a, i), unsafe_get(b, i))) + } + r + } +} + +let iteri = (f, a) => + for i in 0 to length(a) - 1 { + f(i, unsafe_get(a, i)) + } + +let mapi = (f, a) => { + let l = length(a) + if l == 0 { + [] + } else { + let r = create(l, f(0, unsafe_get(a, 0))) + for i in 1 to l - 1 { + unsafe_set(r, i, f(i, unsafe_get(a, i))) + } + r + } +} + +let to_list = a => { + let rec tolist = (i, res) => + if i < 0 { + res + } else { + tolist(i - 1, list{unsafe_get(a, i), ...res}) + } + tolist(length(a) - 1, list{}) +} + +/* Cannot use List.length here because the List module depends on Array. */ +let rec list_length = (accu, param) => + switch param { + | list{} => accu + | list{_, ...t} => list_length(succ(accu), t) + } + +let of_list = param => + switch param { + | list{} => [] + | list{hd, ...tl} as l => + let a = create(list_length(0, l), hd) + let rec fill = (i, param) => + switch param { + | list{} => a + | list{hd, ...tl} => + unsafe_set(a, i, hd) + fill(i + 1, tl) + } + fill(1, tl) + } + +let fold_left = (f, x, a) => { + let r = ref(x) + for i in 0 to length(a) - 1 { + r := f(r.contents, unsafe_get(a, i)) + } + r.contents +} + +let fold_right = (f, a, x) => { + let r = ref(x) + for i in length(a) - 1 downto 0 { + r := f(unsafe_get(a, i), r.contents) + } + r.contents +} + +let exists = (p, a) => { + let n = length(a) + let rec loop = i => + if i == n { + false + } else if p(unsafe_get(a, i)) { + true + } else { + loop(succ(i)) + } + loop(0) +} + +let for_all = (p, a) => { + let n = length(a) + let rec loop = i => + if i == n { + true + } else if p(unsafe_get(a, i)) { + loop(succ(i)) + } else { + false + } + loop(0) +} + +let mem = (x, a) => { + let n = length(a) + let rec loop = i => + if i == n { + false + } else if compare(unsafe_get(a, i), x) == 0 { + true + } else { + loop(succ(i)) + } + loop(0) +} + +let memq = (x, a) => { + let n = length(a) + let rec loop = i => + if i == n { + false + } else if x === unsafe_get(a, i) { + true + } else { + loop(succ(i)) + } + loop(0) +} + +exception Bottom(int) +let sort = (cmp, a) => { + let maxson = (l, i) => { + let i31 = i + i + i + 1 + let x = ref(i31) + if i31 + 2 < l { + if cmp(get(a, i31), get(a, i31 + 1)) < 0 { + x := i31 + 1 + } + if cmp(get(a, x.contents), get(a, i31 + 2)) < 0 { + x := i31 + 2 + } + x.contents + } else if i31 + 1 < l && cmp(get(a, i31), get(a, i31 + 1)) < 0 { + i31 + 1 + } else if i31 < l { + i31 + } else { + raise(Bottom(i)) + } + } + + let rec trickledown = (l, i, e) => { + let j = maxson(l, i) + if cmp(get(a, j), e) > 0 { + set(a, i, get(a, j)) + trickledown(l, j, e) + } else { + set(a, i, e) + } + } + + let trickle = (l, i, e) => + try trickledown(l, i, e) catch { + | Bottom(i) => set(a, i, e) + } + let rec bubbledown = (l, i) => { + let j = maxson(l, i) + set(a, i, get(a, j)) + bubbledown(l, j) + } + + let bubble = (l, i) => + try bubbledown(l, i) catch { + | Bottom(i) => i + } + let rec trickleup = (i, e) => { + let father = (i - 1) / 3 + assert(i != father) + if cmp(get(a, father), e) < 0 { + set(a, i, get(a, father)) + if father > 0 { + trickleup(father, e) + } else { + set(a, 0, e) + } + } else { + set(a, i, e) + } + } + + let l = length(a) + for i in (l + 1) / 3 - 1 downto 0 { + trickle(l, i, get(a, i)) + } + for i in l - 1 downto 2 { + let e = get(a, i) + set(a, i, get(a, 0)) + trickleup(bubble(i, 0), e) + } + if l > 1 { + let e = get(a, 1) + set(a, 1, get(a, 0)) + set(a, 0, e) + } +} + +let cutoff = 5 +let stable_sort = (cmp, a) => { + let merge = (src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs) => { + let src1r = src1ofs + src1len and src2r = src2ofs + src2len + let rec loop = (i1, s1, i2, s2, d) => + if cmp(s1, s2) <= 0 { + set(dst, d, s1) + let i1 = i1 + 1 + if i1 < src1r { + loop(i1, get(a, i1), i2, s2, d + 1) + } else { + blit(src2, i2, dst, d + 1, src2r - i2) + } + } else { + set(dst, d, s2) + let i2 = i2 + 1 + if i2 < src2r { + loop(i1, s1, i2, get(src2, i2), d + 1) + } else { + blit(a, i1, dst, d + 1, src1r - i1) + } + } + loop(src1ofs, get(a, src1ofs), src2ofs, get(src2, src2ofs), dstofs) + } + + let isortto = (srcofs, dst, dstofs, len) => + for i in 0 to len - 1 { + let e = get(a, srcofs + i) + let j = ref(dstofs + i - 1) + while j.contents >= dstofs && cmp(get(dst, j.contents), e) > 0 { + set(dst, j.contents + 1, get(dst, j.contents)) + decr(j) + } + set(dst, j.contents + 1, e) + } + + let rec sortto = (srcofs, dst, dstofs, len) => + if len <= cutoff { + isortto(srcofs, dst, dstofs, len) + } else { + let l1 = len / 2 + let l2 = len - l1 + sortto(srcofs + l1, dst, dstofs + l1, l2) + sortto(srcofs, a, srcofs + l2, l1) + merge(srcofs + l2, l1, dst, dstofs + l1, l2, dst, dstofs) + } + + let l = length(a) + if l <= cutoff { + isortto(0, a, 0, l) + } else { + let l1 = l / 2 + let l2 = l - l1 + let t = make(l2, get(a, 0)) + sortto(l1, t, 0, l2) + sortto(0, a, l2, l1) + merge(l2, l1, t, 0, l2, a, 0) + } +} + +let fast_sort = stable_sort diff --git a/jscomp/stdlib-406/array.resi b/jscomp/stdlib-406/array.resi new file mode 100644 index 0000000000..d12013f3de --- /dev/null +++ b/jscomp/stdlib-406/array.resi @@ -0,0 +1,267 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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. */ + /* */ + /* ************************************************************************ */ + + " Array operations. " +) + +@ocaml.doc(" Return the length (number of elements) of the given array. ") +external length: array<'a> => int = "%array_length" + +@ocaml.doc(" [Array.get a n] returns the element number [n] of array [a]. + The first element has number 0. + The last element has number [Array.length a - 1]. + You can also write [a.(n)] instead of [Array.get a n]. + + Raise [Invalid_argument \"index out of bounds\"] + if [n] is outside the range 0 to [(Array.length a - 1)]. ") +external get: (array<'a>, int) => 'a = "%array_safe_get" + +@ocaml.doc(" [Array.set a n x] modifies array [a] in place, replacing + element number [n] with [x]. + You can also write [a.(n) <- x] instead of [Array.set a n x]. + + Raise [Invalid_argument \"index out of bounds\"] + if [n] is outside the range 0 to [Array.length a - 1]. ") +external set: (array<'a>, int, 'a) => unit = "%array_safe_set" + +@ocaml.doc(" [Array.make n x] returns a fresh array of length [n], + initialized with [x]. + All the elements of this new array are initially + physically equal to [x] (in the sense of the [==] predicate). + Consequently, if [x] is mutable, it is shared among all elements + of the array, and modifying [x] through one of the array entries + will modify all other entries at the same time. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + If the value of [x] is a floating-point number, then the maximum + size is only [Sys.max_array_length / 2].") +external make: (int, 'a) => array<'a> = "?make_vect" + +@ocaml.deprecated("Use Array.make instead.") +@ocaml.doc(" @deprecated [Array.create] is an alias for {!Array.make}. ") +external create: (int, 'a) => array<'a> = "?make_vect" + +@ocaml.doc(" [Array.create_float n] returns a fresh float array of length [n], + with uninitialized data. + @since 4.03 ") +external create_float: int => array = "?make_float_vect" + +@ocaml.deprecated("Use Array.create_float instead.") +@ocaml.doc(" @deprecated [Array.make_float] is an alias for {!Array.create_float}. ") +let make_float: int => array + +@ocaml.doc(" [Array.init n f] returns a fresh array of length [n], + with element number [i] initialized to the result of [f i]. + In other terms, [Array.init n f] tabulates the results of [f] + applied to the integers [0] to [n-1]. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + If the return type of [f] is [float], then the maximum + size is only [Sys.max_array_length / 2].") +let init: (int, int => 'a) => array<'a> + +@ocaml.doc(" [Array.make_matrix dimx dimy e] returns a two-dimensional array + (an array of arrays) with first dimension [dimx] and + second dimension [dimy]. All the elements of this new matrix + are initially physically equal to [e]. + The element ([x,y]) of a matrix [m] is accessed + with the notation [m.(x).(y)]. + + Raise [Invalid_argument] if [dimx] or [dimy] is negative or + greater than {!Sys.max_array_length}. + If the value of [e] is a floating-point number, then the maximum + size is only [Sys.max_array_length / 2]. ") +let make_matrix: (int, int, 'a) => array> + +@ocaml.deprecated("Use Array.make_matrix instead.") +@ocaml.doc(" @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. ") +let create_matrix: (int, int, 'a) => array> + +@ocaml.doc(" [Array.append v1 v2] returns a fresh array containing the + concatenation of the arrays [v1] and [v2]. ") +let append: (array<'a>, array<'a>) => array<'a> + +@ocaml.doc(" Same as {!Array.append}, but concatenates a list of arrays. ") +let concat: list> => array<'a> + +@ocaml.doc(" [Array.sub a start len] returns a fresh array of length [len], + containing the elements number [start] to [start + len - 1] + of array [a]. + + Raise [Invalid_argument \"Array.sub\"] if [start] and [len] do not + designate a valid subarray of [a]; that is, if + [start < 0], or [len < 0], or [start + len > Array.length a]. ") +let sub: (array<'a>, int, int) => array<'a> + +@ocaml.doc(" [Array.copy a] returns a copy of [a], that is, a fresh array + containing the same elements as [a]. ") +let copy: array<'a> => array<'a> + +@ocaml.doc(" [Array.fill a ofs len x] modifies the array [a] in place, + storing [x] in elements number [ofs] to [ofs + len - 1]. + + Raise [Invalid_argument \"Array.fill\"] if [ofs] and [len] do not + designate a valid subarray of [a]. ") +let fill: (array<'a>, int, int, 'a) => unit + +@ocaml.doc(" [Array.blit v1 o1 v2 o2 len] copies [len] elements + from array [v1], starting at element number [o1], to array [v2], + starting at element number [o2]. It works correctly even if + [v1] and [v2] are the same array, and the source and + destination chunks overlap. + + Raise [Invalid_argument \"Array.blit\"] if [o1] and [len] do not + designate a valid subarray of [v1], or if [o2] and [len] do not + designate a valid subarray of [v2]. ") +let blit: (array<'a>, int, array<'a>, int, int) => unit + +@ocaml.doc(" [Array.to_list a] returns the list of all the elements of [a]. ") +let to_list: array<'a> => list<'a> + +@ocaml.doc(" [Array.of_list l] returns a fresh array containing the elements + of [l]. ") +let of_list: list<'a> => array<'a> + +@@ocaml.text(" {1 Iterators} ") + +@ocaml.doc(" [Array.iter f a] applies function [f] in turn to all + the elements of [a]. It is equivalent to + [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. ") +let iter: ('a => unit, array<'a>) => unit + +@ocaml.doc(" Same as {!Array.iter}, but the + function is applied with the index of the element as first argument, + and the element itself as second argument. ") +let iteri: ((int, 'a) => unit, array<'a>) => unit + +@ocaml.doc(" [Array.map f a] applies function [f] to all the elements of [a], + and builds an array with the results returned by [f]: + [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. ") +let map: ('a => 'b, array<'a>) => array<'b> + +@ocaml.doc(" Same as {!Array.map}, but the + function is applied to the index of the element as first argument, + and the element itself as second argument. ") +let mapi: ((int, 'a) => 'b, array<'a>) => array<'b> + +@ocaml.doc(" [Array.fold_left f x a] computes + [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], + where [n] is the length of the array [a]. ") +let fold_left: (('a, 'b) => 'a, 'a, array<'b>) => 'a + +@ocaml.doc(" [Array.fold_right f a x] computes + [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], + where [n] is the length of the array [a]. ") +let fold_right: (('b, 'a) => 'a, array<'b>, 'a) => 'a + +@@ocaml.text(" {1 Iterators on two arrays} ") + +@ocaml.doc(" [Array.iter2 f a b] applies function [f] to all the elements of [a] + and [b]. + Raise [Invalid_argument] if the arrays are not the same size. + @since 4.03.0 ") +let iter2: (('a, 'b) => unit, array<'a>, array<'b>) => unit + +@ocaml.doc(" [Array.map2 f a b] applies function [f] to all the elements of [a] + and [b], and builds an array with the results returned by [f]: + [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. + Raise [Invalid_argument] if the arrays are not the same size. + @since 4.03.0 ") +let map2: (('a, 'b) => 'c, array<'a>, array<'b>) => array<'c> + +@@ocaml.text(" {1 Array scanning} ") + +@ocaml.doc(" [Array.for_all p [|a1; ...; an|]] checks if all elements of the array + satisfy the predicate [p]. That is, it returns + [(p a1) && (p a2) && ... && (p an)]. + @since 4.03.0 ") +let for_all: ('a => bool, array<'a>) => bool + +@ocaml.doc(" [Array.exists p [|a1; ...; an|]] checks if at least one element of + the array satisfies the predicate [p]. That is, it returns + [(p a1) || (p a2) || ... || (p an)]. + @since 4.03.0 ") +let exists: ('a => bool, array<'a>) => bool + +@ocaml.doc(" [mem a l] is true if and only if [a] is equal + to an element of [l]. + @since 4.03.0 ") +let mem: ('a, array<'a>) => bool + +@ocaml.doc(" Same as {!Array.mem}, but uses physical equality instead of structural + equality to compare array elements. + @since 4.03.0 ") +let memq: ('a, array<'a>) => bool + +@@ocaml.text(" {1 Sorting} ") + +@ocaml.doc(" Sort an array in increasing order according to a comparison + function. The comparison function must return 0 if its arguments + compare as equal, a positive integer if the first is greater, + and a negative integer if the first is smaller (see below for a + complete specification). For example, {!Pervasives.compare} is + a suitable comparison function, provided there are no floating-point + NaN values in the data. After calling [Array.sort], the + array is sorted in place in increasing order. + [Array.sort] is guaranteed to run in constant heap space + and (at most) logarithmic stack space. + + The current implementation uses Heap Sort. It runs in constant + stack space. + + Specification of the comparison function: + Let [a] be the array and [cmp] the comparison function. The following + must be true for all x, y, z in a : +- [cmp x y] > 0 if and only if [cmp y x] < 0 +- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 + + When [Array.sort] returns, [a] contains the same elements as before, + reordered in such a way that for all i and j valid indices of [a] : +- [cmp a.(i) a.(j)] >= 0 if and only if i >= j +") +let sort: (('a, 'a) => int, array<'a>) => unit + +@ocaml.doc(" Same as {!Array.sort}, but the sorting algorithm is stable (i.e. + elements that compare equal are kept in their original order) and + not guaranteed to run in constant heap space. + + The current implementation uses Merge Sort. It uses [n/2] + words of heap space, where [n] is the length of the array. + It is usually faster than the current implementation of {!Array.sort}. +") +let stable_sort: (('a, 'a) => int, array<'a>) => unit + +@ocaml.doc(" Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster + on typical input. +") +let fast_sort: (('a, 'a) => int, array<'a>) => unit + +@@ocaml.text("/*") +@@ocaml.text(" {1 Undocumented functions} ") + +/* The following is for system use only. Do not call directly. */ + +external unsafe_get: (array<'a>, int) => 'a = "%array_unsafe_get" +external unsafe_set: (array<'a>, int, 'a) => unit = "%array_unsafe_set" + +module Floatarray: { + external create: int => floatarray = "?floatarray_create" + external length: floatarray => int = "%floatarray_length" + external get: (floatarray, int) => float = "%floatarray_safe_get" + external set: (floatarray, int, float) => unit = "%floatarray_safe_set" + external unsafe_get: (floatarray, int) => float = "%floatarray_unsafe_get" + external unsafe_set: (floatarray, int, float) => unit = "%floatarray_unsafe_set" +} diff --git a/jscomp/stdlib-406/arrayLabels.ml b/jscomp/stdlib-406/arrayLabels.ml deleted file mode 100644 index 290f3bee98..0000000000 --- a/jscomp/stdlib-406/arrayLabels.ml +++ /dev/null @@ -1,307 +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. *) -(* *) -(**************************************************************************) - -(* Array operations *) - -external length : 'a array -> int = "%array_length" -external get: 'a array -> int -> 'a = "%array_safe_get" -external set: 'a array -> int -> 'a -> unit = "%array_safe_set" -external unsafe_get: 'a array -> int -> 'a = "%array_unsafe_get" -external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set" -external make: int -> 'a -> 'a array = "?make_vect" -external create: int -> 'a -> 'a array = "?make_vect" -external unsafe_sub : 'a array -> int -> int -> 'a array = "?array_sub" - -external append_prim : 'a array -> 'a array -> 'a array = "concat" -[@@send] - -external concat : 'a array list -> 'a array = "?array_concat" -external unsafe_blit : - 'a array -> int -> 'a array -> int -> int -> unit = "?array_blit" -external create_float: int -> float array = "?make_float_vect" -let make_float = create_float - -module Floatarray = struct - external create : int -> floatarray = "?floatarray_create" - external length : floatarray -> int = "%floatarray_length" - external get : floatarray -> int -> float = "%floatarray_safe_get" - external set : floatarray -> int -> float -> unit = "%floatarray_safe_set" - external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get" - external unsafe_set : floatarray -> int -> float -> unit - = "%floatarray_unsafe_set" -end - -let init l ~f = - if l = 0 then [||] else - if l < 0 then invalid_arg "Array.init" - (* See #6575. We could also check for maximum array size, but this depends - on whether we create a float array or a regular one... *) - else - let res = create l (f 0) in - for i = 1 to pred l do - unsafe_set res i (f i) - done; - res - -let make_matrix ~dimx:sx ~dimy:sy init = - let res = create sx [||] in - for x = 0 to pred sx do - unsafe_set res x (create sy init) - done; - res - -let create_matrix = make_matrix - -let copy a = - let l = length a in if l = 0 then [||] else unsafe_sub a 0 l - -let append a1 a2 = - let l1 = length a1 in - if l1 = 0 then copy a2 - else if length a2 = 0 then unsafe_sub a1 0 l1 - else append_prim a1 a2 - -let sub a ~pos:ofs ~len = - if ofs < 0 || len < 0 || ofs > length a - len - then invalid_arg "Array.sub" - else unsafe_sub a ofs len - -let fill a ~pos:ofs ~len v = - if ofs < 0 || len < 0 || ofs > length a - len - then invalid_arg "Array.fill" - else for i = ofs to ofs + len - 1 do unsafe_set a i v done - -let blit ~src:a1 ~src_pos:ofs1 ~dst:a2 ~dst_pos:ofs2 ~len = - if len < 0 || ofs1 < 0 || ofs1 > length a1 - len - || ofs2 < 0 || ofs2 > length a2 - len - then invalid_arg "Array.blit" - else unsafe_blit a1 ofs1 a2 ofs2 len - -let iter ~f a = - for i = 0 to length a - 1 do f(unsafe_get a i) done - -let iter2 ~f a b = - if length a <> length b then - invalid_arg "Array.iter2: arrays must have the same length" - else - for i = 0 to length a - 1 do f (unsafe_get a i) (unsafe_get b i) done - -let map ~f a = - let l = length a in - if l = 0 then [||] else begin - let r = create l (f(unsafe_get a 0)) in - for i = 1 to l - 1 do - unsafe_set r i (f(unsafe_get a i)) - done; - r - end - -let map2 ~f a b = - let la = length a in - let lb = length b in - if la <> lb then - invalid_arg "Array.map2: arrays must have the same length" - else begin - if la = 0 then [||] else begin - let r = create la (f (unsafe_get a 0) (unsafe_get b 0)) in - for i = 1 to la - 1 do - unsafe_set r i (f (unsafe_get a i) (unsafe_get b i)) - done; - r - end - end - -let iteri ~f a = - for i = 0 to length a - 1 do f i (unsafe_get a i) done - -let mapi ~f a = - let l = length a in - if l = 0 then [||] else begin - let r = create l (f 0 (unsafe_get a 0)) in - for i = 1 to l - 1 do - unsafe_set r i (f i (unsafe_get a i)) - done; - r - end - -let to_list a = - let rec tolist i res = - if i < 0 then res else tolist (i - 1) (unsafe_get a i :: res) in - tolist (length a - 1) [] - -(* Cannot use List.length here because the List module depends on Array. *) -let rec list_length accu = function - | [] -> accu - | _::t -> list_length (succ accu) t - -let of_list = function - [] -> [||] - | hd::tl as l -> - let a = create (list_length 0 l) hd in - let rec fill i = function - [] -> a - | hd::tl -> unsafe_set a i hd; fill (i+1) tl in - fill 1 tl - -let fold_left ~f ~init:x a = - let r = ref x in - for i = 0 to length a - 1 do - r := f !r (unsafe_get a i) - done; - !r - -let fold_right ~f a ~init:x = - let r = ref x in - for i = length a - 1 downto 0 do - r := f (unsafe_get a i) !r - done; - !r - -let exists ~f:p a = - let n = length a in - let rec loop i = - if i = n then false - else if p (unsafe_get a i) then true - else loop (succ i) in - loop 0 - -let for_all ~f:p a = - let n = length a in - let rec loop i = - if i = n then true - else if p (unsafe_get a i) then loop (succ i) - else false in - loop 0 - -let mem x ~set:a = - let n = length a in - let rec loop i = - if i = n then false - else if compare (unsafe_get a i) x = 0 then true - else loop (succ i) in - loop 0 - -let memq x ~set:a = - let n = length a in - let rec loop i = - if i = n then false - else if x == (unsafe_get a i) then true - else loop (succ i) in - loop 0 - -exception Bottom of int -let sort ~cmp a = - let maxson l i = - let i31 = i+i+i+1 in - let x = ref i31 in - if i31+2 < l then begin - if cmp (get a i31) (get a (i31+1)) < 0 then x := i31+1; - if cmp (get a !x) (get a (i31+2)) < 0 then x := i31+2; - !x - end else - if i31+1 < l && cmp (get a i31) (get a (i31+1)) < 0 - then i31+1 - else if i31 < l then i31 else raise (Bottom i) - in - let rec trickledown l i e = - let j = maxson l i in - if cmp (get a j) e > 0 then begin - set a i (get a j); - trickledown l j e; - end else begin - set a i e; - end; - in - let trickle l i e = try trickledown l i e with Bottom i -> set a i e in - let rec bubbledown l i = - let j = maxson l i in - set a i (get a j); - bubbledown l j - in - let bubble l i = try bubbledown l i with Bottom i -> i in - let rec trickleup i e = - let father = (i - 1) / 3 in - assert (i <> father); - if cmp (get a father) e < 0 then begin - set a i (get a father); - if father > 0 then trickleup father e else set a 0 e; - end else begin - set a i e; - end; - in - let l = length a in - for i = (l + 1) / 3 - 1 downto 0 do trickle l i (get a i); done; - for i = l - 1 downto 2 do - let e = (get a i) in - set a i (get a 0); - trickleup (bubble i 0) e; - done; - if l > 1 then (let e = (get a 1) in set a 1 (get a 0); set a 0 e) - - -let cutoff = 5 -let stable_sort ~cmp a = - let merge src1ofs src1len src2 src2ofs src2len dst dstofs = - let src1r = src1ofs + src1len and src2r = src2ofs + src2len in - let rec loop i1 s1 i2 s2 d = - if cmp s1 s2 <= 0 then begin - set dst d s1; - let i1 = i1 + 1 in - if i1 < src1r then - loop i1 (get a i1) i2 s2 (d + 1) - else - blit ~src:src2 ~src_pos:i2 ~dst ~dst_pos:(d + 1) ~len:(src2r - i2) - end else begin - set dst d s2; - let i2 = i2 + 1 in - if i2 < src2r then - loop i1 s1 i2 (get src2 i2) (d + 1) - else - blit ~src:a ~src_pos:i1 ~dst ~dst_pos:(d + 1) ~len:(src1r - i1) - end - in loop src1ofs (get a src1ofs) src2ofs (get src2 src2ofs) dstofs; - in - let isortto srcofs dst dstofs len = - for i = 0 to len - 1 do - let e = (get a (srcofs + i)) in - let j = ref (dstofs + i - 1) in - while (!j >= dstofs && cmp (get dst !j) e > 0) do - set dst (!j + 1) (get dst !j); - decr j; - done; - set dst (!j + 1) e; - done; - in - let rec sortto srcofs dst dstofs len = - if len <= cutoff then isortto srcofs dst dstofs len else begin - let l1 = len / 2 in - let l2 = len - l1 in - sortto (srcofs + l1) dst (dstofs + l1) l2; - sortto srcofs a (srcofs + l2) l1; - merge (srcofs + l2) l1 dst (dstofs + l1) l2 dst dstofs; - end; - in - let l = length a in - if l <= cutoff then isortto 0 a 0 l else begin - let l1 = l / 2 in - let l2 = l - l1 in - let t = make l2 (get a 0) in - sortto l1 t 0 l2; - sortto 0 a l2 l1; - merge l2 l1 t 0 l2 a 0; - end - - -let fast_sort = stable_sort diff --git a/jscomp/stdlib-406/arrayLabels.mli b/jscomp/stdlib-406/arrayLabels.mli deleted file mode 100644 index 87bb17a5ad..0000000000 --- a/jscomp/stdlib-406/arrayLabels.mli +++ /dev/null @@ -1,276 +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. *) -(* *) -(**************************************************************************) - -(** Array operations. *) - -external length : 'a array -> int = "%array_length" -(** Return the length (number of elements) of the given array. *) - -external get : 'a array -> int -> 'a = "%array_safe_get" -(** [Array.get a n] returns the element number [n] of array [a]. - The first element has number 0. - The last element has number [Array.length a - 1]. - You can also write [a.(n)] instead of [Array.get a n]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [(Array.length a - 1)]. *) - -external set : 'a array -> int -> 'a -> unit = "%array_safe_set" -(** [Array.set a n x] modifies array [a] in place, replacing - element number [n] with [x]. - You can also write [a.(n) <- x] instead of [Array.set a n x]. - - Raise [Invalid_argument "index out of bounds"] - if [n] is outside the range 0 to [Array.length a - 1]. *) - -external make : int -> 'a -> 'a array = "?make_vect" -(** [Array.make n x] returns a fresh array of length [n], - initialized with [x]. - All the elements of this new array are initially - physically equal to [x] (in the sense of the [==] predicate). - Consequently, if [x] is mutable, it is shared among all elements - of the array, and modifying [x] through one of the array entries - will modify all other entries at the same time. - - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. - If the value of [x] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2].*) - -external create : int -> 'a -> 'a array = "?make_vect" - [@@ocaml.deprecated "Use Array.make instead."] -(** @deprecated [Array.create] is an alias for {!Array.make}. *) - -val init : int -> f:(int -> 'a) -> 'a array -(** [Array.init n f] returns a fresh array of length [n], - with element number [i] initialized to the result of [f i]. - In other terms, [Array.init n f] tabulates the results of [f] - applied to the integers [0] to [n-1]. - - Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. - If the return type of [f] is [float], then the maximum - size is only [Sys.max_array_length / 2].*) - -val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array -(** [Array.make_matrix dimx dimy e] returns a two-dimensional array - (an array of arrays) with first dimension [dimx] and - second dimension [dimy]. All the elements of this new matrix - are initially physically equal to [e]. - The element ([x,y]) of a matrix [m] is accessed - with the notation [m.(x).(y)]. - - Raise [Invalid_argument] if [dimx] or [dimy] is negative or - greater than {!Sys.max_array_length}. - If the value of [e] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2]. *) - -val create_matrix : dimx:int -> dimy:int -> 'a -> 'a array array - [@@ocaml.deprecated "Use Array.make_matrix instead."] -(** @deprecated [Array.create_matrix] is an alias for - {!Array.make_matrix}. *) - -val append : 'a array -> 'a array -> 'a array -(** [Array.append v1 v2] returns a fresh array containing the - concatenation of the arrays [v1] and [v2]. *) - -val concat : 'a array list -> 'a array -(** Same as {!Array.append}, but concatenates a list of arrays. *) - -val sub : 'a array -> pos:int -> len:int -> 'a array -(** [Array.sub a start len] returns a fresh array of length [len], - containing the elements number [start] to [start + len - 1] - of array [a]. - - Raise [Invalid_argument "Array.sub"] if [start] and [len] do not - designate a valid subarray of [a]; that is, if - [start < 0], or [len < 0], or [start + len > Array.length a]. *) - -val copy : 'a array -> 'a array -(** [Array.copy a] returns a copy of [a], that is, a fresh array - containing the same elements as [a]. *) - -val fill : 'a array -> pos:int -> len:int -> 'a -> unit -(** [Array.fill a ofs len x] modifies the array [a] in place, - storing [x] in elements number [ofs] to [ofs + len - 1]. - - Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not - designate a valid subarray of [a]. *) - -val blit : - src:'a array -> src_pos:int -> dst:'a array -> dst_pos:int -> len:int -> - unit -(** [Array.blit v1 o1 v2 o2 len] copies [len] elements - from array [v1], starting at element number [o1], to array [v2], - starting at element number [o2]. It works correctly even if - [v1] and [v2] are the same array, and the source and - destination chunks overlap. - - Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not - designate a valid subarray of [v1], or if [o2] and [len] do not - designate a valid subarray of [v2]. *) - -val to_list : 'a array -> 'a list -(** [Array.to_list a] returns the list of all the elements of [a]. *) - -val of_list : 'a list -> 'a array -(** [Array.of_list l] returns a fresh array containing the elements - of [l]. *) - -val iter : f:('a -> unit) -> 'a array -> unit -(** [Array.iter f a] applies function [f] in turn to all - the elements of [a]. It is equivalent to - [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. *) - -val map : f:('a -> 'b) -> 'a array -> 'b array -(** [Array.map f a] applies function [f] to all the elements of [a], - and builds an array with the results returned by [f]: - [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. *) - -val iteri : f:(int -> 'a -> unit) -> 'a array -> unit -(** Same as {!Array.iter}, but the - function is applied to the index of the element as first argument, - and the element itself as second argument. *) - -val mapi : f:(int -> 'a -> 'b) -> 'a array -> 'b array -(** Same as {!Array.map}, but the - function is applied to the index of the element as first argument, - and the element itself as second argument. *) - -val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b array -> 'a -(** [Array.fold_left f x a] computes - [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], - where [n] is the length of the array [a]. *) - -val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a -(** [Array.fold_right f a x] computes - [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], - where [n] is the length of the array [a]. *) - - -(** {6 Iterators on two arrays} *) - - -val iter2 : f:('a -> 'b -> unit) -> 'a array -> 'b array -> unit -(** [Array.iter2 f a b] applies function [f] to all the elements of [a] - and [b]. - Raise [Invalid_argument] if the arrays are not the same size. - @since 4.05.0 *) - -val map2 : f:('a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array -(** [Array.map2 f a b] applies function [f] to all the elements of [a] - and [b], and builds an array with the results returned by [f]: - [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. - Raise [Invalid_argument] if the arrays are not the same size. - @since 4.05.0 *) - - -(** {6 Array scanning} *) - - -val exists : f:('a -> bool) -> 'a array -> bool -(** [Array.exists p [|a1; ...; an|]] checks if at least one element of - the array satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. - @since 4.03.0 *) - -val for_all : f:('a -> bool) -> 'a array -> bool -(** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. - @since 4.03.0 *) - -val mem : 'a -> set:'a array -> bool -(** [mem x a] is true if and only if [x] is equal - to an element of [a]. - @since 4.03.0 *) - -val memq : 'a -> set:'a array -> bool -(** Same as {!Array.mem}, but uses physical equality instead of structural - equality to compare list elements. - @since 4.03.0 *) - -external create_float: int -> float array = "?make_float_vect" -(** [Array.create_float n] returns a fresh float array of length [n], - with uninitialized data. - @since 4.03 *) - -val make_float: int -> float array - [@@ocaml.deprecated "Use Array.create_float instead."] -(** @deprecated [Array.make_float] is an alias for - {!Array.create_float}. *) - - -(** {1 Sorting} *) - - -val sort : cmp:('a -> 'a -> int) -> 'a array -> unit -(** Sort an array in increasing order according to a comparison - function. The comparison function must return 0 if its arguments - compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller (see below for a - complete specification). For example, {!Pervasives.compare} is - a suitable comparison function, provided there are no floating-point - NaN values in the data. After calling [Array.sort], the - array is sorted in place in increasing order. - [Array.sort] is guaranteed to run in constant heap space - and (at most) logarithmic stack space. - - The current implementation uses Heap Sort. It runs in constant - stack space. - - Specification of the comparison function: - Let [a] be the array and [cmp] the comparison function. The following - must be true for all x, y, z in a : -- [cmp x y] > 0 if and only if [cmp y x] < 0 -- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 - - When [Array.sort] returns, [a] contains the same elements as before, - reordered in such a way that for all i and j valid indices of [a] : -- [cmp a.(i) a.(j)] >= 0 if and only if i >= j -*) - -val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit -(** Same as {!Array.sort}, but the sorting algorithm is stable (i.e. - elements that compare equal are kept in their original order) and - not guaranteed to run in constant heap space. - - The current implementation uses Merge Sort. It uses [n/2] - words of heap space, where [n] is the length of the array. - It is usually faster than the current implementation of {!Array.sort}. -*) - -val fast_sort : cmp:('a -> 'a -> int) -> 'a array -> unit -(** Same as {!Array.sort} or {!Array.stable_sort}, whichever is - faster on typical input. -*) - - -(**/**) - -(** {1 Undocumented functions} *) - -(* The following is for system use only. Do not call directly. *) - -external unsafe_get : 'a array -> int -> 'a = "%array_unsafe_get" -external unsafe_set : 'a array -> int -> 'a -> unit = "%array_unsafe_set" - -module Floatarray : sig - external create : int -> floatarray = "?floatarray_create" - external length : floatarray -> int = "%floatarray_length" - external get : floatarray -> int -> float = "%floatarray_safe_get" - external set : floatarray -> int -> float -> unit = "%floatarray_safe_set" - external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get" - external unsafe_set : floatarray -> int -> float -> unit - = "%floatarray_unsafe_set" -end diff --git a/jscomp/stdlib-406/arrayLabels.res b/jscomp/stdlib-406/arrayLabels.res new file mode 100644 index 0000000000..e67752553b --- /dev/null +++ b/jscomp/stdlib-406/arrayLabels.res @@ -0,0 +1,410 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Array operations */ + +external length: array<'a> => int = "%array_length" +external get: (array<'a>, int) => 'a = "%array_safe_get" +external set: (array<'a>, int, 'a) => unit = "%array_safe_set" +external unsafe_get: (array<'a>, int) => 'a = "%array_unsafe_get" +external unsafe_set: (array<'a>, int, 'a) => unit = "%array_unsafe_set" +external make: (int, 'a) => array<'a> = "?make_vect" +external create: (int, 'a) => array<'a> = "?make_vect" +external unsafe_sub: (array<'a>, int, int) => array<'a> = "?array_sub" + +@send external append_prim: (array<'a>, array<'a>) => array<'a> = "concat" + +external concat: list> => array<'a> = "?array_concat" +external unsafe_blit: (array<'a>, int, array<'a>, int, int) => unit = "?array_blit" +external create_float: int => array = "?make_float_vect" +let make_float = create_float + +module Floatarray = { + external create: int => floatarray = "?floatarray_create" + external length: floatarray => int = "%floatarray_length" + external get: (floatarray, int) => float = "%floatarray_safe_get" + external set: (floatarray, int, float) => unit = "%floatarray_safe_set" + external unsafe_get: (floatarray, int) => float = "%floatarray_unsafe_get" + external unsafe_set: (floatarray, int, float) => unit = "%floatarray_unsafe_set" +} + +let init = (l, ~f) => + if l == 0 { + [] + } else if l < 0 { + invalid_arg("Array.init") + } else { + /* See #6575. We could also check for maximum array size, but this depends + on whether we create a float array or a regular one... */ + + let res = create(l, f(0)) + for i in 1 to pred(l) { + unsafe_set(res, i, f(i)) + } + res + } + +let make_matrix = (~dimx as sx, ~dimy as sy, init) => { + let res = create(sx, []) + for x in 0 to pred(sx) { + unsafe_set(res, x, create(sy, init)) + } + res +} + +let create_matrix = make_matrix + +let copy = a => { + let l = length(a) + if l == 0 { + [] + } else { + unsafe_sub(a, 0, l) + } +} + +let append = (a1, a2) => { + let l1 = length(a1) + if l1 == 0 { + copy(a2) + } else if length(a2) == 0 { + unsafe_sub(a1, 0, l1) + } else { + append_prim(a1, a2) + } +} + +let sub = (a, ~pos as ofs, ~len) => + if ofs < 0 || (len < 0 || ofs > length(a) - len) { + invalid_arg("Array.sub") + } else { + unsafe_sub(a, ofs, len) + } + +let fill = (a, ~pos as ofs, ~len, v) => + if ofs < 0 || (len < 0 || ofs > length(a) - len) { + invalid_arg("Array.fill") + } else { + for i in ofs to ofs + len - 1 { + unsafe_set(a, i, v) + } + } + +let blit = (~src as a1, ~src_pos as ofs1, ~dst as a2, ~dst_pos as ofs2, ~len) => + if len < 0 || (ofs1 < 0 || (ofs1 > length(a1) - len || (ofs2 < 0 || ofs2 > length(a2) - len))) { + invalid_arg("Array.blit") + } else { + unsafe_blit(a1, ofs1, a2, ofs2, len) + } + +let iter = (~f, a) => + for i in 0 to length(a) - 1 { + f(unsafe_get(a, i)) + } + +let iter2 = (~f, a, b) => + if length(a) != length(b) { + invalid_arg("Array.iter2: arrays must have the same length") + } else { + for i in 0 to length(a) - 1 { + f(unsafe_get(a, i), unsafe_get(b, i)) + } + } + +let map = (~f, a) => { + let l = length(a) + if l == 0 { + [] + } else { + let r = create(l, f(unsafe_get(a, 0))) + for i in 1 to l - 1 { + unsafe_set(r, i, f(unsafe_get(a, i))) + } + r + } +} + +let map2 = (~f, a, b) => { + let la = length(a) + let lb = length(b) + if la != lb { + invalid_arg("Array.map2: arrays must have the same length") + } else if la == 0 { + [] + } else { + let r = create(la, f(unsafe_get(a, 0), unsafe_get(b, 0))) + for i in 1 to la - 1 { + unsafe_set(r, i, f(unsafe_get(a, i), unsafe_get(b, i))) + } + r + } +} + +let iteri = (~f, a) => + for i in 0 to length(a) - 1 { + f(i, unsafe_get(a, i)) + } + +let mapi = (~f, a) => { + let l = length(a) + if l == 0 { + [] + } else { + let r = create(l, f(0, unsafe_get(a, 0))) + for i in 1 to l - 1 { + unsafe_set(r, i, f(i, unsafe_get(a, i))) + } + r + } +} + +let to_list = a => { + let rec tolist = (i, res) => + if i < 0 { + res + } else { + tolist(i - 1, list{unsafe_get(a, i), ...res}) + } + tolist(length(a) - 1, list{}) +} + +/* Cannot use List.length here because the List module depends on Array. */ +let rec list_length = (accu, param) => + switch param { + | list{} => accu + | list{_, ...t} => list_length(succ(accu), t) + } + +let of_list = param => + switch param { + | list{} => [] + | list{hd, ...tl} as l => + let a = create(list_length(0, l), hd) + let rec fill = (i, param) => + switch param { + | list{} => a + | list{hd, ...tl} => + unsafe_set(a, i, hd) + fill(i + 1, tl) + } + fill(1, tl) + } + +let fold_left = (~f, ~init as x, a) => { + let r = ref(x) + for i in 0 to length(a) - 1 { + r := f(r.contents, unsafe_get(a, i)) + } + r.contents +} + +let fold_right = (~f, a, ~init as x) => { + let r = ref(x) + for i in length(a) - 1 downto 0 { + r := f(unsafe_get(a, i), r.contents) + } + r.contents +} + +let exists = (~f as p, a) => { + let n = length(a) + let rec loop = i => + if i == n { + false + } else if p(unsafe_get(a, i)) { + true + } else { + loop(succ(i)) + } + loop(0) +} + +let for_all = (~f as p, a) => { + let n = length(a) + let rec loop = i => + if i == n { + true + } else if p(unsafe_get(a, i)) { + loop(succ(i)) + } else { + false + } + loop(0) +} + +let mem = (x, ~set as a) => { + let n = length(a) + let rec loop = i => + if i == n { + false + } else if compare(unsafe_get(a, i), x) == 0 { + true + } else { + loop(succ(i)) + } + loop(0) +} + +let memq = (x, ~set as a) => { + let n = length(a) + let rec loop = i => + if i == n { + false + } else if x === unsafe_get(a, i) { + true + } else { + loop(succ(i)) + } + loop(0) +} + +exception Bottom(int) +let sort = (~cmp, a) => { + let maxson = (l, i) => { + let i31 = i + i + i + 1 + let x = ref(i31) + if i31 + 2 < l { + if cmp(get(a, i31), get(a, i31 + 1)) < 0 { + x := i31 + 1 + } + if cmp(get(a, x.contents), get(a, i31 + 2)) < 0 { + x := i31 + 2 + } + x.contents + } else if i31 + 1 < l && cmp(get(a, i31), get(a, i31 + 1)) < 0 { + i31 + 1 + } else if i31 < l { + i31 + } else { + raise(Bottom(i)) + } + } + + let rec trickledown = (l, i, e) => { + let j = maxson(l, i) + if cmp(get(a, j), e) > 0 { + set(a, i, get(a, j)) + trickledown(l, j, e) + } else { + set(a, i, e) + } + } + + let trickle = (l, i, e) => + try trickledown(l, i, e) catch { + | Bottom(i) => set(a, i, e) + } + let rec bubbledown = (l, i) => { + let j = maxson(l, i) + set(a, i, get(a, j)) + bubbledown(l, j) + } + + let bubble = (l, i) => + try bubbledown(l, i) catch { + | Bottom(i) => i + } + let rec trickleup = (i, e) => { + let father = (i - 1) / 3 + assert(i != father) + if cmp(get(a, father), e) < 0 { + set(a, i, get(a, father)) + if father > 0 { + trickleup(father, e) + } else { + set(a, 0, e) + } + } else { + set(a, i, e) + } + } + + let l = length(a) + for i in (l + 1) / 3 - 1 downto 0 { + trickle(l, i, get(a, i)) + } + for i in l - 1 downto 2 { + let e = get(a, i) + set(a, i, get(a, 0)) + trickleup(bubble(i, 0), e) + } + if l > 1 { + let e = get(a, 1) + set(a, 1, get(a, 0)) + set(a, 0, e) + } +} + +let cutoff = 5 +let stable_sort = (~cmp, a) => { + let merge = (src1ofs, src1len, src2, src2ofs, src2len, dst, dstofs) => { + let src1r = src1ofs + src1len and src2r = src2ofs + src2len + let rec loop = (i1, s1, i2, s2, d) => + if cmp(s1, s2) <= 0 { + set(dst, d, s1) + let i1 = i1 + 1 + if i1 < src1r { + loop(i1, get(a, i1), i2, s2, d + 1) + } else { + blit(~src=src2, ~src_pos=i2, ~dst, ~dst_pos=d + 1, ~len=src2r - i2) + } + } else { + set(dst, d, s2) + let i2 = i2 + 1 + if i2 < src2r { + loop(i1, s1, i2, get(src2, i2), d + 1) + } else { + blit(~src=a, ~src_pos=i1, ~dst, ~dst_pos=d + 1, ~len=src1r - i1) + } + } + loop(src1ofs, get(a, src1ofs), src2ofs, get(src2, src2ofs), dstofs) + } + + let isortto = (srcofs, dst, dstofs, len) => + for i in 0 to len - 1 { + let e = get(a, srcofs + i) + let j = ref(dstofs + i - 1) + while j.contents >= dstofs && cmp(get(dst, j.contents), e) > 0 { + set(dst, j.contents + 1, get(dst, j.contents)) + decr(j) + } + set(dst, j.contents + 1, e) + } + + let rec sortto = (srcofs, dst, dstofs, len) => + if len <= cutoff { + isortto(srcofs, dst, dstofs, len) + } else { + let l1 = len / 2 + let l2 = len - l1 + sortto(srcofs + l1, dst, dstofs + l1, l2) + sortto(srcofs, a, srcofs + l2, l1) + merge(srcofs + l2, l1, dst, dstofs + l1, l2, dst, dstofs) + } + + let l = length(a) + if l <= cutoff { + isortto(0, a, 0, l) + } else { + let l1 = l / 2 + let l2 = l - l1 + let t = make(l2, get(a, 0)) + sortto(l1, t, 0, l2) + sortto(0, a, l2, l1) + merge(l2, l1, t, 0, l2, a, 0) + } +} + +let fast_sort = stable_sort diff --git a/jscomp/stdlib-406/arrayLabels.resi b/jscomp/stdlib-406/arrayLabels.resi new file mode 100644 index 0000000000..db4fa2cd4f --- /dev/null +++ b/jscomp/stdlib-406/arrayLabels.resi @@ -0,0 +1,268 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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. */ + /* */ + /* ************************************************************************ */ + + " Array operations. " +) + +@ocaml.doc(" Return the length (number of elements) of the given array. ") +external length: array<'a> => int = "%array_length" + +@ocaml.doc(" [Array.get a n] returns the element number [n] of array [a]. + The first element has number 0. + The last element has number [Array.length a - 1]. + You can also write [a.(n)] instead of [Array.get a n]. + + Raise [Invalid_argument \"index out of bounds\"] + if [n] is outside the range 0 to [(Array.length a - 1)]. ") +external get: (array<'a>, int) => 'a = "%array_safe_get" + +@ocaml.doc(" [Array.set a n x] modifies array [a] in place, replacing + element number [n] with [x]. + You can also write [a.(n) <- x] instead of [Array.set a n x]. + + Raise [Invalid_argument \"index out of bounds\"] + if [n] is outside the range 0 to [Array.length a - 1]. ") +external set: (array<'a>, int, 'a) => unit = "%array_safe_set" + +@ocaml.doc(" [Array.make n x] returns a fresh array of length [n], + initialized with [x]. + All the elements of this new array are initially + physically equal to [x] (in the sense of the [==] predicate). + Consequently, if [x] is mutable, it is shared among all elements + of the array, and modifying [x] through one of the array entries + will modify all other entries at the same time. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + If the value of [x] is a floating-point number, then the maximum + size is only [Sys.max_array_length / 2].") +external make: (int, 'a) => array<'a> = "?make_vect" + +@ocaml.deprecated("Use Array.make instead.") +@ocaml.doc(" @deprecated [Array.create] is an alias for {!Array.make}. ") +external create: (int, 'a) => array<'a> = "?make_vect" + +@ocaml.doc(" [Array.init n f] returns a fresh array of length [n], + with element number [i] initialized to the result of [f i]. + In other terms, [Array.init n f] tabulates the results of [f] + applied to the integers [0] to [n-1]. + + Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. + If the return type of [f] is [float], then the maximum + size is only [Sys.max_array_length / 2].") +let init: (int, ~f: int => 'a) => array<'a> + +@ocaml.doc(" [Array.make_matrix dimx dimy e] returns a two-dimensional array + (an array of arrays) with first dimension [dimx] and + second dimension [dimy]. All the elements of this new matrix + are initially physically equal to [e]. + The element ([x,y]) of a matrix [m] is accessed + with the notation [m.(x).(y)]. + + Raise [Invalid_argument] if [dimx] or [dimy] is negative or + greater than {!Sys.max_array_length}. + If the value of [e] is a floating-point number, then the maximum + size is only [Sys.max_array_length / 2]. ") +let make_matrix: (~dimx: int, ~dimy: int, 'a) => array> + +@ocaml.deprecated("Use Array.make_matrix instead.") +@ocaml.doc(" @deprecated [Array.create_matrix] is an alias for + {!Array.make_matrix}. ") +let create_matrix: (~dimx: int, ~dimy: int, 'a) => array> + +@ocaml.doc(" [Array.append v1 v2] returns a fresh array containing the + concatenation of the arrays [v1] and [v2]. ") +let append: (array<'a>, array<'a>) => array<'a> + +@ocaml.doc(" Same as {!Array.append}, but concatenates a list of arrays. ") +let concat: list> => array<'a> + +@ocaml.doc(" [Array.sub a start len] returns a fresh array of length [len], + containing the elements number [start] to [start + len - 1] + of array [a]. + + Raise [Invalid_argument \"Array.sub\"] if [start] and [len] do not + designate a valid subarray of [a]; that is, if + [start < 0], or [len < 0], or [start + len > Array.length a]. ") +let sub: (array<'a>, ~pos: int, ~len: int) => array<'a> + +@ocaml.doc(" [Array.copy a] returns a copy of [a], that is, a fresh array + containing the same elements as [a]. ") +let copy: array<'a> => array<'a> + +@ocaml.doc(" [Array.fill a ofs len x] modifies the array [a] in place, + storing [x] in elements number [ofs] to [ofs + len - 1]. + + Raise [Invalid_argument \"Array.fill\"] if [ofs] and [len] do not + designate a valid subarray of [a]. ") +let fill: (array<'a>, ~pos: int, ~len: int, 'a) => unit + +@ocaml.doc(" [Array.blit v1 o1 v2 o2 len] copies [len] elements + from array [v1], starting at element number [o1], to array [v2], + starting at element number [o2]. It works correctly even if + [v1] and [v2] are the same array, and the source and + destination chunks overlap. + + Raise [Invalid_argument \"Array.blit\"] if [o1] and [len] do not + designate a valid subarray of [v1], or if [o2] and [len] do not + designate a valid subarray of [v2]. ") +let blit: (~src: array<'a>, ~src_pos: int, ~dst: array<'a>, ~dst_pos: int, ~len: int) => unit + +@ocaml.doc(" [Array.to_list a] returns the list of all the elements of [a]. ") +let to_list: array<'a> => list<'a> + +@ocaml.doc(" [Array.of_list l] returns a fresh array containing the elements + of [l]. ") +let of_list: list<'a> => array<'a> + +@ocaml.doc(" [Array.iter f a] applies function [f] in turn to all + the elements of [a]. It is equivalent to + [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. ") +let iter: (~f: 'a => unit, array<'a>) => unit + +@ocaml.doc(" [Array.map f a] applies function [f] to all the elements of [a], + and builds an array with the results returned by [f]: + [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. ") +let map: (~f: 'a => 'b, array<'a>) => array<'b> + +@ocaml.doc(" Same as {!Array.iter}, but the + function is applied to the index of the element as first argument, + and the element itself as second argument. ") +let iteri: (~f: (int, 'a) => unit, array<'a>) => unit + +@ocaml.doc(" Same as {!Array.map}, but the + function is applied to the index of the element as first argument, + and the element itself as second argument. ") +let mapi: (~f: (int, 'a) => 'b, array<'a>) => array<'b> + +@ocaml.doc(" [Array.fold_left f x a] computes + [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], + where [n] is the length of the array [a]. ") +let fold_left: (~f: ('a, 'b) => 'a, ~init: 'a, array<'b>) => 'a + +@ocaml.doc(" [Array.fold_right f a x] computes + [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], + where [n] is the length of the array [a]. ") +let fold_right: (~f: ('b, 'a) => 'a, array<'b>, ~init: 'a) => 'a + +@@ocaml.text(" {6 Iterators on two arrays} ") + +@ocaml.doc(" [Array.iter2 f a b] applies function [f] to all the elements of [a] + and [b]. + Raise [Invalid_argument] if the arrays are not the same size. + @since 4.05.0 ") +let iter2: (~f: ('a, 'b) => unit, array<'a>, array<'b>) => unit + +@ocaml.doc(" [Array.map2 f a b] applies function [f] to all the elements of [a] + and [b], and builds an array with the results returned by [f]: + [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. + Raise [Invalid_argument] if the arrays are not the same size. + @since 4.05.0 ") +let map2: (~f: ('a, 'b) => 'c, array<'a>, array<'b>) => array<'c> + +@@ocaml.text(" {6 Array scanning} ") + +@ocaml.doc(" [Array.exists p [|a1; ...; an|]] checks if at least one element of + the array satisfies the predicate [p]. That is, it returns + [(p a1) || (p a2) || ... || (p an)]. + @since 4.03.0 ") +let exists: (~f: 'a => bool, array<'a>) => bool + +@ocaml.doc(" [Array.for_all p [|a1; ...; an|]] checks if all elements of the array + satisfy the predicate [p]. That is, it returns + [(p a1) && (p a2) && ... && (p an)]. + @since 4.03.0 ") +let for_all: (~f: 'a => bool, array<'a>) => bool + +@ocaml.doc(" [mem x a] is true if and only if [x] is equal + to an element of [a]. + @since 4.03.0 ") +let mem: ('a, ~set: array<'a>) => bool + +@ocaml.doc(" Same as {!Array.mem}, but uses physical equality instead of structural + equality to compare list elements. + @since 4.03.0 ") +let memq: ('a, ~set: array<'a>) => bool + +@ocaml.doc(" [Array.create_float n] returns a fresh float array of length [n], + with uninitialized data. + @since 4.03 ") +external create_float: int => array = "?make_float_vect" + +@ocaml.deprecated("Use Array.create_float instead.") +@ocaml.doc(" @deprecated [Array.make_float] is an alias for + {!Array.create_float}. ") +let make_float: int => array + +@@ocaml.text(" {1 Sorting} ") + +@ocaml.doc(" Sort an array in increasing order according to a comparison + function. The comparison function must return 0 if its arguments + compare as equal, a positive integer if the first is greater, + and a negative integer if the first is smaller (see below for a + complete specification). For example, {!Pervasives.compare} is + a suitable comparison function, provided there are no floating-point + NaN values in the data. After calling [Array.sort], the + array is sorted in place in increasing order. + [Array.sort] is guaranteed to run in constant heap space + and (at most) logarithmic stack space. + + The current implementation uses Heap Sort. It runs in constant + stack space. + + Specification of the comparison function: + Let [a] be the array and [cmp] the comparison function. The following + must be true for all x, y, z in a : +- [cmp x y] > 0 if and only if [cmp y x] < 0 +- if [cmp x y] >= 0 and [cmp y z] >= 0 then [cmp x z] >= 0 + + When [Array.sort] returns, [a] contains the same elements as before, + reordered in such a way that for all i and j valid indices of [a] : +- [cmp a.(i) a.(j)] >= 0 if and only if i >= j +") +let sort: (~cmp: ('a, 'a) => int, array<'a>) => unit + +@ocaml.doc(" Same as {!Array.sort}, but the sorting algorithm is stable (i.e. + elements that compare equal are kept in their original order) and + not guaranteed to run in constant heap space. + + The current implementation uses Merge Sort. It uses [n/2] + words of heap space, where [n] is the length of the array. + It is usually faster than the current implementation of {!Array.sort}. +") +let stable_sort: (~cmp: ('a, 'a) => int, array<'a>) => unit + +@ocaml.doc(" Same as {!Array.sort} or {!Array.stable_sort}, whichever is + faster on typical input. +") +let fast_sort: (~cmp: ('a, 'a) => int, array<'a>) => unit + +@@ocaml.text("/*") + +@@ocaml.text(" {1 Undocumented functions} ") + +/* The following is for system use only. Do not call directly. */ + +external unsafe_get: (array<'a>, int) => 'a = "%array_unsafe_get" +external unsafe_set: (array<'a>, int, 'a) => unit = "%array_unsafe_set" + +module Floatarray: { + external create: int => floatarray = "?floatarray_create" + external length: floatarray => int = "%floatarray_length" + external get: (floatarray, int) => float = "%floatarray_safe_get" + external set: (floatarray, int, float) => unit = "%floatarray_safe_set" + external unsafe_get: (floatarray, int) => float = "%floatarray_unsafe_get" + external unsafe_set: (floatarray, int, float) => unit = "%floatarray_unsafe_set" +} diff --git a/jscomp/stdlib-406/buffer.ml b/jscomp/stdlib-406/buffer.ml deleted file mode 100644 index 28a95b7813..0000000000 --- a/jscomp/stdlib-406/buffer.ml +++ /dev/null @@ -1,250 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1999 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Extensible buffers *) - -type t = - {mutable buffer : bytes; - mutable position : int; - mutable length : int; - initial_buffer : bytes} - -let create n = - let n = if n < 1 then 1 else n in - let s = Bytes.create n in - {buffer = s; position = 0; length = n; initial_buffer = s} - -let contents b = Bytes.sub_string b.buffer 0 b.position -let to_bytes b = Bytes.sub b.buffer 0 b.position - -let sub b ofs len = - if ofs < 0 || len < 0 || ofs > b.position - len - then invalid_arg "Buffer.sub" - else Bytes.sub_string b.buffer ofs len - - -let blit src srcoff dst dstoff len = - if len < 0 || srcoff < 0 || srcoff > src.position - len - || dstoff < 0 || dstoff > (Bytes.length dst) - len - then invalid_arg "Buffer.blit" - else - Bytes.blit src.buffer srcoff dst dstoff len - - -let nth b ofs = - if ofs < 0 || ofs >= b.position then - invalid_arg "Buffer.nth" - else Bytes.unsafe_get b.buffer ofs - - -let length b = b.position - -let clear b = b.position <- 0 - -let reset b = - b.position <- 0; b.buffer <- b.initial_buffer; - b.length <- Bytes.length b.buffer - -let resize b more = - let len = b.length in - let new_len = ref len in - while b.position + more > !new_len do new_len := 2 * !new_len done; - let new_buffer = Bytes.create !new_len in - (* PR#6148: let's keep using [blit] rather than [unsafe_blit] in - this tricky function that is slow anyway. *) - Bytes.blit b.buffer 0 new_buffer 0 b.position; - b.buffer <- new_buffer; - b.length <- !new_len - -let add_char b c = - let pos = b.position in - if pos >= b.length then resize b 1; - Bytes.unsafe_set b.buffer pos c; - b.position <- pos + 1 - - let add_utf_8_uchar b u = match Uchar.to_int u with - | u when u < 0 -> assert false - | u when u <= 0x007F -> - add_char b (Char.unsafe_chr u) - | u when u <= 0x07FF -> - let pos = b.position in - if pos + 2 > b.length then resize b 2; - Bytes.unsafe_set b.buffer (pos ) - (Char.unsafe_chr (0xC0 lor (u lsr 6))); - Bytes.unsafe_set b.buffer (pos + 1) - (Char.unsafe_chr (0x80 lor (u land 0x3F))); - b.position <- pos + 2 - | u when u <= 0xFFFF -> - let pos = b.position in - if pos + 3 > b.length then resize b 3; - Bytes.unsafe_set b.buffer (pos ) - (Char.unsafe_chr (0xE0 lor (u lsr 12))); - Bytes.unsafe_set b.buffer (pos + 1) - (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F))); - Bytes.unsafe_set b.buffer (pos + 2) - (Char.unsafe_chr (0x80 lor (u land 0x3F))); - b.position <- pos + 3 - | u when u <= 0x10FFFF -> - let pos = b.position in - if pos + 4 > b.length then resize b 4; - Bytes.unsafe_set b.buffer (pos ) - (Char.unsafe_chr (0xF0 lor (u lsr 18))); - Bytes.unsafe_set b.buffer (pos + 1) - (Char.unsafe_chr (0x80 lor ((u lsr 12) land 0x3F))); - Bytes.unsafe_set b.buffer (pos + 2) - (Char.unsafe_chr (0x80 lor ((u lsr 6) land 0x3F))); - Bytes.unsafe_set b.buffer (pos + 3) - (Char.unsafe_chr (0x80 lor (u land 0x3F))); - b.position <- pos + 4 - | _ -> assert false - - let add_utf_16be_uchar b u = match Uchar.to_int u with - | u when u < 0 -> assert false - | u when u <= 0xFFFF -> - let pos = b.position in - if pos + 2 > b.length then resize b 2; - Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (u lsr 8)); - Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u land 0xFF)); - b.position <- pos + 2 - | u when u <= 0x10FFFF -> - let u' = u - 0x10000 in - let hi = 0xD800 lor (u' lsr 10) in - let lo = 0xDC00 lor (u' land 0x3FF) in - let pos = b.position in - if pos + 4 > b.length then resize b 4; - Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (hi lsr 8)); - Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi land 0xFF)); - Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo lsr 8)); - Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo land 0xFF)); - b.position <- pos + 4 - | _ -> assert false - - let add_utf_16le_uchar b u = match Uchar.to_int u with - | u when u < 0 -> assert false - | u when u <= 0xFFFF -> - let pos = b.position in - if pos + 2 > b.length then resize b 2; - Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (u land 0xFF)); - Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (u lsr 8)); - b.position <- pos + 2 - | u when u <= 0x10FFFF -> - let u' = u - 0x10000 in - let hi = 0xD800 lor (u' lsr 10) in - let lo = 0xDC00 lor (u' land 0x3FF) in - let pos = b.position in - if pos + 4 > b.length then resize b 4; - Bytes.unsafe_set b.buffer (pos ) (Char.unsafe_chr (hi land 0xFF)); - Bytes.unsafe_set b.buffer (pos + 1) (Char.unsafe_chr (hi lsr 8)); - Bytes.unsafe_set b.buffer (pos + 2) (Char.unsafe_chr (lo land 0xFF)); - Bytes.unsafe_set b.buffer (pos + 3) (Char.unsafe_chr (lo lsr 8)); - b.position <- pos + 4 - | _ -> assert false - -let add_substring b s offset len = - if offset < 0 || len < 0 || offset > String.length s - len - then invalid_arg "Buffer.add_substring/add_subbytes"; - let new_position = b.position + len in - if new_position > b.length then resize b len; - Bytes.blit_string s offset b.buffer b.position len; - b.position <- new_position - -let add_subbytes b s offset len = - add_substring b (Bytes.unsafe_to_string s) offset len - -let add_string b s = - let len = String.length s in - let new_position = b.position + len in - if new_position > b.length then resize b len; - Bytes.blit_string s 0 b.buffer b.position len; - b.position <- new_position - -let add_bytes b s = add_string b (Bytes.unsafe_to_string s) - -let add_buffer b bs = - add_subbytes b bs.buffer 0 bs.position - -let closing = function - | '(' -> ')' - | '{' -> '}' - | _ -> assert false - -(* opening and closing: open and close characters, typically ( and ) - k: balance of opening and closing chars - s: the string where we are searching - start: the index where we start the search. *) -let advance_to_closing opening closing k s start = - let rec advance k i lim = - if i >= lim then raise Not_found else - if s.[i] = opening then advance (k + 1) (i + 1) lim else - if s.[i] = closing then - if k = 0 then i else advance (k - 1) (i + 1) lim - else advance k (i + 1) lim in - advance k start (String.length s) - -let advance_to_non_alpha s start = - let rec advance i lim = - if i >= lim then lim else - match s.[i] with - | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' -> advance (i + 1) lim - | _ -> i in - advance start (String.length s) - -(* We are just at the beginning of an ident in s, starting at start. *) -let find_ident s start lim = - if start >= lim then raise Not_found else - match s.[start] with - (* Parenthesized ident ? *) - | '(' | '{' as c -> - let new_start = start + 1 in - let stop = advance_to_closing c (closing c) 0 s new_start in - String.sub s new_start (stop - start - 1), stop + 1 - (* Regular ident *) - | _ -> - let stop = advance_to_non_alpha s (start + 1) in - String.sub s start (stop - start), stop - -(* Substitute $ident, $(ident), or ${ident} in s, - according to the function mapping f. *) -let add_substitute b f s = - let lim = String.length s in - let rec subst previous i = - if i < lim then begin - match s.[i] with - | '$' as current when previous = '\\' -> - add_char b current; - subst ' ' (i + 1) - | '$' -> - let j = i + 1 in - let ident, next_i = find_ident s j lim in - add_string b (f ident); - subst ' ' next_i - | current when previous == '\\' -> - add_char b '\\'; - add_char b current; - subst ' ' (i + 1) - | '\\' as current -> - subst current (i + 1) - | current -> - add_char b current; - subst current (i + 1) - end else - if previous = '\\' then add_char b previous in - subst ' ' 0 - -let truncate b len = - if len < 0 || len > length b then - invalid_arg "Buffer.truncate" - else - b.position <- len diff --git a/jscomp/stdlib-406/buffer.mli b/jscomp/stdlib-406/buffer.mli deleted file mode 100644 index 494baf951d..0000000000 --- a/jscomp/stdlib-406/buffer.mli +++ /dev/null @@ -1,149 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1999 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Extensible buffers. - - This module implements buffers that automatically expand - as necessary. It provides accumulative concatenation of strings - in quasi-linear time (instead of quadratic time when strings are - concatenated pairwise). -*) - -type t -(** The abstract type of buffers. *) - -val create : int -> t -(** [create n] returns a fresh buffer, initially empty. - The [n] parameter is the initial size of the internal byte sequence - that holds the buffer contents. That byte sequence is automatically - reallocated when more than [n] characters are stored in the buffer, - but shrinks back to [n] characters when [reset] is called. - For best performance, [n] should be of the same order of magnitude - as the number of characters that are expected to be stored in - the buffer (for instance, 80 for a buffer that holds one output - line). Nothing bad will happen if the buffer grows beyond that - limit, however. In doubt, take [n = 16] for instance. - If [n] is not between 1 and {!Sys.max_string_length}, it will - be clipped to that interval. *) - -val contents : t -> string -(** Return a copy of the current contents of the buffer. - The buffer itself is unchanged. *) - -val to_bytes : t -> bytes -(** Return a copy of the current contents of the buffer. - The buffer itself is unchanged. - @since 4.02 *) - -val sub : t -> int -> int -> string -(** [Buffer.sub b off len] returns a copy of [len] bytes from the - current contents of the buffer [b], starting at offset [off]. - - Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid - range of [b]. *) - -val blit : t -> int -> bytes -> int -> int -> unit -(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from - the current contents of the buffer [src], starting at offset [srcoff] - to [dst], starting at character [dstoff]. - - Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid - range of [src], or if [dstoff] and [len] do not designate a valid - range of [dst]. - @since 3.11.2 -*) - -val nth : t -> int -> char -(** Get the n-th character of the buffer. Raise [Invalid_argument] if - index out of bounds *) - -val length : t -> int -(** Return the number of characters currently contained in the buffer. *) - -val clear : t -> unit -(** Empty the buffer. *) - -val reset : t -> unit -(** Empty the buffer and deallocate the internal byte sequence holding the - buffer contents, replacing it with the initial internal byte sequence - of length [n] that was allocated by {!Buffer.create} [n]. - For long-lived buffers that may have grown a lot, [reset] allows - faster reclamation of the space used by the buffer. *) - -val add_char : t -> char -> unit -(** [add_char b c] appends the character [c] at the end of buffer [b]. *) - -val add_utf_8_uchar : t -> Uchar.t -> unit -(** [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629} - UTF-8} encoding of [u] at the end of buffer [b]. - - @since 4.06.0 *) - -val add_utf_16le_uchar : t -> Uchar.t -> unit -(** [add_utf_16le_uchar b u] appends the - {{:https://tools.ietf.org/html/rfc2781}UTF-16LE} encoding of [u] - at the end of buffer [b]. - - @since 4.06.0 *) - -val add_utf_16be_uchar : t -> Uchar.t -> unit -(** [add_utf_16be_uchar b u] appends the - {{:https://tools.ietf.org/html/rfc2781}UTF-16BE} encoding of [u] - at the end of buffer [b]. - - @since 4.06.0 *) - -val add_string : t -> string -> unit -(** [add_string b s] appends the string [s] at the end of buffer [b]. *) - -val add_bytes : t -> bytes -> unit -(** [add_bytes b s] appends the byte sequence [s] at the end of buffer [b]. - @since 4.02 *) - -val add_substring : t -> string -> int -> int -> unit -(** [add_substring b s ofs len] takes [len] characters from offset - [ofs] in string [s] and appends them at the end of buffer [b]. *) - -val add_subbytes : t -> bytes -> int -> int -> unit -(** [add_subbytes b s ofs len] takes [len] characters from offset - [ofs] in byte sequence [s] and appends them at the end of buffer [b]. - @since 4.02 *) - -val add_substitute : t -> (string -> string) -> string -> unit -(** [add_substitute b f s] appends the string pattern [s] at the end - of buffer [b] with substitution. - The substitution process looks for variables into - the pattern and substitutes each variable name by its value, as - obtained by applying the mapping [f] to the variable name. Inside the - string pattern, a variable name immediately follows a non-escaped - [$] character and is one of the following: - - a non empty sequence of alphanumeric or [_] characters, - - an arbitrary sequence of characters enclosed by a pair of - matching parentheses or curly brackets. - An escaped [$] character is a [$] that immediately follows a backslash - character; it then stands for a plain [$]. - Raise [Not_found] if the closing character of a parenthesized variable - cannot be found. *) - -val add_buffer : t -> t -> unit -(** [add_buffer b1 b2] appends the current contents of buffer [b2] - at the end of buffer [b1]. [b2] is not modified. *) - - -val truncate : t -> int -> unit -(** [truncate b len] truncates the length of [b] to [len] - Note: the internal byte sequence is not shortened. - Raise [Invalid_argument] if [len < 0] or [len > length b]. - @since 4.05.0 *) diff --git a/jscomp/stdlib-406/buffer.res b/jscomp/stdlib-406/buffer.res new file mode 100644 index 0000000000..6d9db8c24d --- /dev/null +++ b/jscomp/stdlib-406/buffer.res @@ -0,0 +1,307 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1999 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +/* Extensible buffers */ + +type t = { + mutable buffer: bytes, + mutable position: int, + mutable length: int, + initial_buffer: bytes, +} + +let create = n => { + let n = if n < 1 { + 1 + } else { + n + } + let s = Bytes.create(n) + {buffer: s, position: 0, length: n, initial_buffer: s} +} + +let contents = b => Bytes.sub_string(b.buffer, 0, b.position) +let to_bytes = b => Bytes.sub(b.buffer, 0, b.position) + +let sub = (b, ofs, len) => + if ofs < 0 || (len < 0 || ofs > b.position - len) { + invalid_arg("Buffer.sub") + } else { + Bytes.sub_string(b.buffer, ofs, len) + } + +let blit = (src, srcoff, dst, dstoff, len) => + if ( + len < 0 || + (srcoff < 0 || + (srcoff > src.position - len || (dstoff < 0 || dstoff > Bytes.length(dst) - len))) + ) { + invalid_arg("Buffer.blit") + } else { + Bytes.blit(src.buffer, srcoff, dst, dstoff, len) + } + +let nth = (b, ofs) => + if ofs < 0 || ofs >= b.position { + invalid_arg("Buffer.nth") + } else { + Bytes.unsafe_get(b.buffer, ofs) + } + +let length = b => b.position + +let clear = b => b.position = 0 + +let reset = b => { + b.position = 0 + b.buffer = b.initial_buffer + b.length = Bytes.length(b.buffer) +} + +let resize = (b, more) => { + let len = b.length + let new_len = ref(len) + while b.position + more > new_len.contents { + new_len := 2 * new_len.contents + } + let new_buffer = Bytes.create(new_len.contents) + /* PR#6148: let's keep using [blit] rather than [unsafe_blit] in + this tricky function that is slow anyway. */ + Bytes.blit(b.buffer, 0, new_buffer, 0, b.position) + b.buffer = new_buffer + b.length = new_len.contents +} + +let add_char = (b, c) => { + let pos = b.position + if pos >= b.length { + resize(b, 1) + } + Bytes.unsafe_set(b.buffer, pos, c) + b.position = pos + 1 +} + +let add_utf_8_uchar = (b, u) => + switch Uchar.to_int(u) { + | u if u < 0 => assert(false) + | u if u <= 0x007F => add_char(b, Char.unsafe_chr(u)) + | u if u <= 0x07FF => + let pos = b.position + if pos + 2 > b.length { + resize(b, 2) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(lor(0xC0, lsr(u, 6)))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(lor(0x80, land(u, 0x3F)))) + b.position = pos + 2 + | u if u <= 0xFFFF => + let pos = b.position + if pos + 3 > b.length { + resize(b, 3) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(lor(0xE0, lsr(u, 12)))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(lor(0x80, land(lsr(u, 6), 0x3F)))) + Bytes.unsafe_set(b.buffer, pos + 2, Char.unsafe_chr(lor(0x80, land(u, 0x3F)))) + b.position = pos + 3 + | u if u <= 0x10FFFF => + let pos = b.position + if pos + 4 > b.length { + resize(b, 4) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(lor(0xF0, lsr(u, 18)))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(lor(0x80, land(lsr(u, 12), 0x3F)))) + Bytes.unsafe_set(b.buffer, pos + 2, Char.unsafe_chr(lor(0x80, land(lsr(u, 6), 0x3F)))) + Bytes.unsafe_set(b.buffer, pos + 3, Char.unsafe_chr(lor(0x80, land(u, 0x3F)))) + b.position = pos + 4 + | _ => assert(false) + } + +let add_utf_16be_uchar = (b, u) => + switch Uchar.to_int(u) { + | u if u < 0 => assert(false) + | u if u <= 0xFFFF => + let pos = b.position + if pos + 2 > b.length { + resize(b, 2) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(lsr(u, 8))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(land(u, 0xFF))) + b.position = pos + 2 + | u if u <= 0x10FFFF => + let u' = u - 0x10000 + let hi = lor(0xD800, lsr(u', 10)) + let lo = lor(0xDC00, land(u', 0x3FF)) + let pos = b.position + if pos + 4 > b.length { + resize(b, 4) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(lsr(hi, 8))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(land(hi, 0xFF))) + Bytes.unsafe_set(b.buffer, pos + 2, Char.unsafe_chr(lsr(lo, 8))) + Bytes.unsafe_set(b.buffer, pos + 3, Char.unsafe_chr(land(lo, 0xFF))) + b.position = pos + 4 + | _ => assert(false) + } + +let add_utf_16le_uchar = (b, u) => + switch Uchar.to_int(u) { + | u if u < 0 => assert(false) + | u if u <= 0xFFFF => + let pos = b.position + if pos + 2 > b.length { + resize(b, 2) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(land(u, 0xFF))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(lsr(u, 8))) + b.position = pos + 2 + | u if u <= 0x10FFFF => + let u' = u - 0x10000 + let hi = lor(0xD800, lsr(u', 10)) + let lo = lor(0xDC00, land(u', 0x3FF)) + let pos = b.position + if pos + 4 > b.length { + resize(b, 4) + } + Bytes.unsafe_set(b.buffer, pos, Char.unsafe_chr(land(hi, 0xFF))) + Bytes.unsafe_set(b.buffer, pos + 1, Char.unsafe_chr(lsr(hi, 8))) + Bytes.unsafe_set(b.buffer, pos + 2, Char.unsafe_chr(land(lo, 0xFF))) + Bytes.unsafe_set(b.buffer, pos + 3, Char.unsafe_chr(lsr(lo, 8))) + b.position = pos + 4 + | _ => assert(false) + } + +let add_substring = (b, s, offset, len) => { + if offset < 0 || (len < 0 || offset > String.length(s) - len) { + invalid_arg("Buffer.add_substring/add_subbytes") + } + let new_position = b.position + len + if new_position > b.length { + resize(b, len) + } + Bytes.blit_string(s, offset, b.buffer, b.position, len) + b.position = new_position +} + +let add_subbytes = (b, s, offset, len) => add_substring(b, Bytes.unsafe_to_string(s), offset, len) + +let add_string = (b, s) => { + let len = String.length(s) + let new_position = b.position + len + if new_position > b.length { + resize(b, len) + } + Bytes.blit_string(s, 0, b.buffer, b.position, len) + b.position = new_position +} + +let add_bytes = (b, s) => add_string(b, Bytes.unsafe_to_string(s)) + +let add_buffer = (b, bs) => add_subbytes(b, bs.buffer, 0, bs.position) + +let closing = param => + switch param { + | '(' => ')' + | '{' => '}' + | _ => assert(false) + } + +/* opening and closing: open and close characters, typically ( and ) + k: balance of opening and closing chars + s: the string where we are searching + start: the index where we start the search. */ +let advance_to_closing = (opening, closing, k, s, start) => { + let rec advance = (k, i, lim) => + if i >= lim { + raise(Not_found) + } else if String.get(s, i) == opening { + advance(k + 1, i + 1, lim) + } else if String.get(s, i) == closing { + if k == 0 { + i + } else { + advance(k - 1, i + 1, lim) + } + } else { + advance(k, i + 1, lim) + } + advance(k, start, String.length(s)) +} + +let advance_to_non_alpha = (s, start) => { + let rec advance = (i, lim) => + if i >= lim { + lim + } else { + switch String.get(s, i) { + | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' => advance(i + 1, lim) + | _ => i + } + } + advance(start, String.length(s)) +} + +/* We are just at the beginning of an ident in s, starting at start. */ +let find_ident = (s, start, lim) => + if start >= lim { + raise(Not_found) + } else { + switch String.get(s, start) { + /* Parenthesized ident ? */ + | ('(' | '{') as c => + let new_start = start + 1 + let stop = advance_to_closing(c, closing(c), 0, s, new_start) + (String.sub(s, new_start, stop - start - 1), stop + 1) + /* Regular ident */ + | _ => + let stop = advance_to_non_alpha(s, start + 1) + (String.sub(s, start, stop - start), stop) + } + } + +/* Substitute $ident, $(ident), or ${ident} in s, + according to the function mapping f. */ +let add_substitute = (b, f, s) => { + let lim = String.length(s) + let rec subst = (previous, i) => + if i < lim { + switch String.get(s, i) { + | '$' as current if previous == '\\' => + add_char(b, current) + subst(' ', i + 1) + | '$' => + let j = i + 1 + let (ident, next_i) = find_ident(s, j, lim) + add_string(b, f(ident)) + subst(' ', next_i) + | current if previous === '\\' => + add_char(b, '\\') + add_char(b, current) + subst(' ', i + 1) + | '\\' as current => subst(current, i + 1) + | current => + add_char(b, current) + subst(current, i + 1) + } + } else if previous == '\\' { + add_char(b, previous) + } + subst(' ', 0) +} + +let truncate = (b, len) => + if len < 0 || len > length(b) { + invalid_arg("Buffer.truncate") + } else { + b.position = len + } diff --git a/jscomp/stdlib-406/buffer.resi b/jscomp/stdlib-406/buffer.resi new file mode 100644 index 0000000000..3fe7fdc793 --- /dev/null +++ b/jscomp/stdlib-406/buffer.resi @@ -0,0 +1,148 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Pierre Weis and Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1999 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +" Extensible buffers. + + This module implements buffers that automatically expand + as necessary. It provides accumulative concatenation of strings + in quasi-linear time (instead of quadratic time when strings are + concatenated pairwise). +") + +@ocaml.doc(" The abstract type of buffers. ") +type t + +@ocaml.doc(" [create n] returns a fresh buffer, initially empty. + The [n] parameter is the initial size of the internal byte sequence + that holds the buffer contents. That byte sequence is automatically + reallocated when more than [n] characters are stored in the buffer, + but shrinks back to [n] characters when [reset] is called. + For best performance, [n] should be of the same order of magnitude + as the number of characters that are expected to be stored in + the buffer (for instance, 80 for a buffer that holds one output + line). Nothing bad will happen if the buffer grows beyond that + limit, however. In doubt, take [n = 16] for instance. + If [n] is not between 1 and {!Sys.max_string_length}, it will + be clipped to that interval. ") +let create: int => t + +@ocaml.doc(" Return a copy of the current contents of the buffer. + The buffer itself is unchanged. ") +let contents: t => string + +@ocaml.doc(" Return a copy of the current contents of the buffer. + The buffer itself is unchanged. + @since 4.02 ") +let to_bytes: t => bytes + +@ocaml.doc(" [Buffer.sub b off len] returns a copy of [len] bytes from the + current contents of the buffer [b], starting at offset [off]. + + Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid + range of [b]. ") +let sub: (t, int, int) => string + +@ocaml.doc(" [Buffer.blit src srcoff dst dstoff len] copies [len] characters from + the current contents of the buffer [src], starting at offset [srcoff] + to [dst], starting at character [dstoff]. + + Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid + range of [src], or if [dstoff] and [len] do not designate a valid + range of [dst]. + @since 3.11.2 +") +let blit: (t, int, bytes, int, int) => unit + +@ocaml.doc(" Get the n-th character of the buffer. Raise [Invalid_argument] if + index out of bounds ") +let nth: (t, int) => char + +@ocaml.doc(" Return the number of characters currently contained in the buffer. ") +let length: t => int + +@ocaml.doc(" Empty the buffer. ") +let clear: t => unit + +@ocaml.doc(" Empty the buffer and deallocate the internal byte sequence holding the + buffer contents, replacing it with the initial internal byte sequence + of length [n] that was allocated by {!Buffer.create} [n]. + For long-lived buffers that may have grown a lot, [reset] allows + faster reclamation of the space used by the buffer. ") +let reset: t => unit + +@ocaml.doc(" [add_char b c] appends the character [c] at the end of buffer [b]. ") +let add_char: (t, char) => unit + +@ocaml.doc(" [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629} + UTF-8} encoding of [u] at the end of buffer [b]. + + @since 4.06.0 ") +let add_utf_8_uchar: (t, Uchar.t) => unit + +@ocaml.doc(" [add_utf_16le_uchar b u] appends the + {{:https://tools.ietf.org/html/rfc2781}UTF-16LE} encoding of [u] + at the end of buffer [b]. + + @since 4.06.0 ") +let add_utf_16le_uchar: (t, Uchar.t) => unit + +@ocaml.doc(" [add_utf_16be_uchar b u] appends the + {{:https://tools.ietf.org/html/rfc2781}UTF-16BE} encoding of [u] + at the end of buffer [b]. + + @since 4.06.0 ") +let add_utf_16be_uchar: (t, Uchar.t) => unit + +@ocaml.doc(" [add_string b s] appends the string [s] at the end of buffer [b]. ") +let add_string: (t, string) => unit + +@ocaml.doc(" [add_bytes b s] appends the byte sequence [s] at the end of buffer [b]. + @since 4.02 ") +let add_bytes: (t, bytes) => unit + +@ocaml.doc(" [add_substring b s ofs len] takes [len] characters from offset + [ofs] in string [s] and appends them at the end of buffer [b]. ") +let add_substring: (t, string, int, int) => unit + +@ocaml.doc(" [add_subbytes b s ofs len] takes [len] characters from offset + [ofs] in byte sequence [s] and appends them at the end of buffer [b]. + @since 4.02 ") +let add_subbytes: (t, bytes, int, int) => unit + +@ocaml.doc(" [add_substitute b f s] appends the string pattern [s] at the end + of buffer [b] with substitution. + The substitution process looks for variables into + the pattern and substitutes each variable name by its value, as + obtained by applying the mapping [f] to the variable name. Inside the + string pattern, a variable name immediately follows a non-escaped + [$] character and is one of the following: + - a non empty sequence of alphanumeric or [_] characters, + - an arbitrary sequence of characters enclosed by a pair of + matching parentheses or curly brackets. + An escaped [$] character is a [$] that immediately follows a backslash + character; it then stands for a plain [$]. + Raise [Not_found] if the closing character of a parenthesized variable + cannot be found. ") +let add_substitute: (t, string => string, string) => unit + +@ocaml.doc(" [add_buffer b1 b2] appends the current contents of buffer [b2] + at the end of buffer [b1]. [b2] is not modified. ") +let add_buffer: (t, t) => unit + +@ocaml.doc(" [truncate b len] truncates the length of [b] to [len] + Note: the internal byte sequence is not shortened. + Raise [Invalid_argument] if [len < 0] or [len > length b]. + @since 4.05.0 ") +let truncate: (t, int) => unit diff --git a/jscomp/stdlib-406/bytes.ml b/jscomp/stdlib-406/bytes.ml deleted file mode 100644 index 2061366b75..0000000000 --- a/jscomp/stdlib-406/bytes.ml +++ /dev/null @@ -1,431 +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. *) -(* *) -(**************************************************************************) - -(* Byte sequence operations *) - -(* WARNING: Some functions in this file are duplicated in string.ml for - efficiency reasons. When you modify the one in this file you need to - modify its duplicate in string.ml. - These functions have a "duplicated" comment above their definition. -*) - - - -external of_small_int_array : - (_ [@bs.as {json|null|json}] ) -> - int array -> string = - "String.fromCharCode.apply" - [@@bs.val] - -external (.!()) : string -> int -> char = "%string_unsafe_get" -external length : bytes -> int = "%bytes_length" -external%private string_length : string -> int = "%string_length" -external get : bytes -> int -> char = "%bytes_safe_get" -external set : bytes -> int -> char -> unit = "%bytes_safe_set" -external create : int -> bytes = "?create_bytes" - -external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get" -external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" -external (.![]) : bytes -> int -> char = "%bytes_unsafe_get" -external (.![]<-) : bytes -> int -> char -> unit = "%bytes_unsafe_set" -external new_uninitialized : int -> bytes = "Array" [@@bs.new] -external to_int_array : bytes -> int array = "%identity" - -let unsafe_fill : bytes -> int -> int -> char -> unit - = fun (s : bytes) i l (c : char) -> - if l > 0 then - for k = i to l + i - 1 do - s.![k] <- c - done - - - - -(** Same as {!Array.prototype.copyWithin} *) -let copyWithin (s1 : bytes) i1 i2 len = - if i1 < i2 then (* nop for i1 = i2 *) - let range_a = length s1 - i2 - 1 in - let range_b = len - 1 in - let range = if range_a > range_b then range_b else range_a in - for j = range downto 0 do - s1.![i2 + j] <- s1.![i1 + j] - done - else if i1 > i2 then - let range_a = length s1 - i1 - 1 in - let range_b = len - 1 in - let range = if range_a > range_b then range_b else range_a in - for k = 0 to range do - s1.![i2 + k] <- s1.![i1 + k] - done - -(* TODO: when the compiler could optimize small function calls, - use high order functions instead -*) -let unsafe_blit (s1:bytes) i1 (s2:bytes) i2 len = - if len > 0 then - if s1 == s2 then - copyWithin s1 i1 i2 len - else - let off1 = length s1 - i1 in - if len <= off1 then - for i = 0 to len - 1 do - s2.![i2 + i] <- s1.![i1 + i] - done - else - begin - for i = 0 to off1 - 1 do - s2.![i2 + i] <- s1.![i1 + i] - done; - for i = off1 to len - 1 do - s2.![i2 + i] <- '\000' - done - end - -let unsafe_blit_string (s1 : string) i1 (s2 : bytes) i2 (len : int ) = - if len > 0 then - let off1 = string_length s1 - i1 in - if len <= off1 then - for i = 0 to len - 1 do - s2.![i2 + i] <- s1.!(i1 + i) - done - else - begin - for i = 0 to off1 - 1 do - s2.![i2 + i] <- s1.!(i1 + i) - done; - for i = off1 to len - 1 do - s2.![i2 + i] <- '\000' - done - end -let string_of_large_bytes (bytes : bytes) i len = - let s = ref "" in - let s_len = ref len in - let seg = 1024 in - if i = 0 && len <= 4 * seg && len = length bytes then - of_small_int_array (to_int_array bytes) - else - begin - let offset = ref 0 in - while s_len.contents > 0 do - let next = if s_len.contents < 1024 then s_len.contents else seg in - let tmp_bytes = new_uninitialized next in - for k = 0 to next - 1 do - tmp_bytes.![k] <- bytes.![k + offset.contents] - done; - s.contents <- s.contents ^ of_small_int_array (to_int_array tmp_bytes); - s_len.contents <- s_len.contents - next ; - offset.contents <- offset.contents + next; - done; - s.contents - end - - -let make n c = - let s = create n in - unsafe_fill s 0 n c; - s - -let init n f = - let s = create n in - for i = 0 to n - 1 do - unsafe_set s i (f i) - done; - s - -let empty = create 0 - -let copy s = - let len = length s in - let r = create len in - unsafe_blit s 0 r 0 len; - r - -let to_string (a : bytes) : string = - string_of_large_bytes a 0 (length a) - -let unsafe_to_string = to_string - -(** checkout [Bytes.empty] -- to be inlined? *) -let of_string (s : string) = - let len = string_length s in - let res = new_uninitialized len in - for i = 0 to len - 1 do - res.![i] <- s.!(i) - (* Note that when get a char and convert it to int immedately, should be optimized - should be [s.charCodeAt[i]] - *) - done; - res - -let unsafe_of_string = of_string - -let sub s ofs len = - if ofs < 0 || len < 0 || ofs > length s - len - then invalid_arg "String.sub / Bytes.sub" - else begin - let r = create len in - unsafe_blit s ofs r 0 len; - r - end - -let sub_string b ofs len = unsafe_to_string (sub b ofs len) - -(* addition with an overflow check *) -let (++) a b = - let c = a + b in - match a < 0, b < 0, c < 0 with - | true , true , false - | false, false, true -> invalid_arg "Bytes.extend" (* overflow *) - | _ -> c - -let extend s left right = - let len = length s ++ left ++ right in - let r = create len in - let (srcoff, dstoff) = if left < 0 then -left, 0 else 0, left in - let cpylen = min (length s - srcoff) (len - dstoff) in - if cpylen > 0 then unsafe_blit s srcoff r dstoff cpylen; - r - -let fill s ofs len c = - if ofs < 0 || len < 0 || ofs > length s - len - then invalid_arg "String.fill / Bytes.fill" - else unsafe_fill s ofs len c - -let blit s1 ofs1 s2 ofs2 len = - if len < 0 || ofs1 < 0 || ofs1 > length s1 - len - || ofs2 < 0 || ofs2 > length s2 - len - then invalid_arg "Bytes.blit" - else unsafe_blit s1 ofs1 s2 ofs2 len - -let blit_string s1 ofs1 s2 ofs2 len = - if len < 0 || ofs1 < 0 || ofs1 > string_length s1 - len - || ofs2 < 0 || ofs2 > length s2 - len - then invalid_arg "String.blit / Bytes.blit_string" - else unsafe_blit_string s1 ofs1 s2 ofs2 len - -(* duplicated in string.ml *) -let iter f a = - for i = 0 to length a - 1 do f(unsafe_get a i) done - -(* duplicated in string.ml *) -let iteri f a = - for i = 0 to length a - 1 do f i (unsafe_get a i) done - -let ensure_ge (x:int) y = if x >= y then x else invalid_arg "Bytes.concat" - -let rec sum_lengths acc seplen = function - | [] -> acc - | hd :: [] -> length hd + acc - | hd :: tl -> sum_lengths (ensure_ge (length hd + seplen + acc) acc) seplen tl - -let rec unsafe_blits dst pos sep seplen = function - [] -> dst - | hd :: [] -> - unsafe_blit hd 0 dst pos (length hd); dst - | hd :: tl -> - unsafe_blit hd 0 dst pos (length hd); - unsafe_blit sep 0 dst (pos + length hd) seplen; - unsafe_blits dst (pos + length hd + seplen) sep seplen tl - -let concat sep = function - [] -> empty - | l -> let seplen = length sep in - unsafe_blits - (create (sum_lengths 0 seplen l)) - 0 sep seplen l - -let cat s1 s2 = - let l1 = length s1 in - let l2 = length s2 in - let r = create (l1 + l2) in - unsafe_blit s1 0 r 0 l1; - unsafe_blit s2 0 r l1 l2; - r - - -external char_chr: int -> char = "%identity" - -let is_space = function - | ' ' | '\012' | '\n' | '\r' | '\t' -> true - | _ -> false - -let trim s = - let len = length s in - let i = ref 0 in - while !i < len && is_space (unsafe_get s !i) do - incr i - done; - let j = ref (len - 1) in - while !j >= !i && is_space (unsafe_get s !j) do - decr j - done; - if !j >= !i then - sub s !i (!j - !i + 1) - else - empty - -let escaped s = - let n = ref 0 in - for i = 0 to length s - 1 do - n := !n + - (match unsafe_get s i with - | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 - | ' ' .. '~' -> 1 - | _ -> 4) - done; - if !n = length s then copy s else begin - let s' = create !n in - n := 0; - for i = 0 to length s - 1 do - begin match unsafe_get s i with - | ('\"' | '\\') as c -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c - | '\n' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n' - | '\t' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't' - | '\r' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r' - | '\b' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b' - | (' ' .. '~') as c -> unsafe_set s' !n c - | c -> - let a = (c :> int) in - unsafe_set s' !n '\\'; - incr n; - unsafe_set s' !n (char_chr (48 + a / 100)); - incr n; - unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); - incr n; - unsafe_set s' !n (char_chr (48 + a mod 10)); - end; - incr n - done; - s' - end - -let map f s = - let l = length s in - if l = 0 then s else begin - let r = create l in - for i = 0 to l - 1 do unsafe_set r i (f (unsafe_get s i)) done; - r - end - -let mapi f s = - let l = length s in - if l = 0 then s else begin - let r = create l in - for i = 0 to l - 1 do unsafe_set r i (f i (unsafe_get s i)) done; - r - end - -let uppercase_ascii s = map Char.uppercase_ascii s -let lowercase_ascii s = map Char.lowercase_ascii s - -let apply1 f s = - if length s = 0 then s else begin - let r = copy s in - unsafe_set r 0 (f(unsafe_get s 0)); - r - end - -let capitalize_ascii s = apply1 Char.uppercase_ascii s -let uncapitalize_ascii s = apply1 Char.lowercase_ascii s - -(* duplicated in string.ml *) -let rec index_rec s lim i c = - if i >= lim then raise Not_found else - if unsafe_get s i = c then i else index_rec s lim (i + 1) c - -(* duplicated in string.ml *) -let index s c = index_rec s (length s) 0 c - -(* duplicated in string.ml *) -let rec index_rec_opt s lim i c = - if i >= lim then None else - if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c - -(* duplicated in string.ml *) -let index_opt s c = index_rec_opt s (length s) 0 c - -(* duplicated in string.ml *) -let index_from s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else - index_rec s l i c - -(* duplicated in string.ml *) -let index_from_opt s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else - index_rec_opt s l i c - -(* duplicated in string.ml *) -let rec rindex_rec s i c = - if i < 0 then raise Not_found else - if unsafe_get s i = c then i else rindex_rec s (i - 1) c - -(* duplicated in string.ml *) -let rindex s c = rindex_rec s (length s - 1) c - -(* duplicated in string.ml *) -let rindex_from s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from / Bytes.rindex_from" - else - rindex_rec s i c - -(* duplicated in string.ml *) -let rec rindex_rec_opt s i c = - if i < 0 then None else - if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c - -(* duplicated in string.ml *) -let rindex_opt s c = rindex_rec_opt s (length s - 1) c - -(* duplicated in string.ml *) -let rindex_from_opt s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt" - else - rindex_rec_opt s i c - - -(* duplicated in string.ml *) -let contains_from s i c = - let l = length s in - if i < 0 || i > l then - invalid_arg "String.contains_from / Bytes.contains_from" - else - try ignore (index_rec s l i c); true with Not_found -> false - - -(* duplicated in string.ml *) -let contains s c = contains_from s 0 c - -(* duplicated in string.ml *) -let rcontains_from s i c = - if i < 0 || i >= length s then - invalid_arg "String.rcontains_from / Bytes.rcontains_from" - else - try ignore (rindex_rec s i c); true with Not_found -> false - - -type t = bytes - -let compare (x: t) (y: t) = Pervasives.compare x y -let equal (x : t) (y : t) = x = y - diff --git a/jscomp/stdlib-406/bytes.res b/jscomp/stdlib-406/bytes.res new file mode 100644 index 0000000000000000000000000000000000000000..d7f9c5cb7b623da73096b8f280aff6ffd111309a GIT binary patch literal 13113 zcmd5@`)?b^5$?}I|A-BNL`RFFB_Svp!BXO=L0}+I0y{+t*amYtF2$9Pcg)>UmKwW% zd%v04=aH7^S5dW=$bHQ7o7vg9%fkoi!6*7r4<7D3e4y-~pU?6|nGXFczc#v2Kk25v z9jRqgU+GSrHKy(Ia-^P|KYj98J*|sBR=O(cRnw)r&+6rEV=m{NI{fCFzo{ox+nH|F zsq?%ub(NQDs?}3n%yol*N>^AhtD6O8K~RB{h=+;CtFE@=g9vt8=KV2i#f^pX@*__&t>V;Ob zRaM9|OX}>HH(E_sOBf?3J7SKET3wC-88~f6DWzvKQy3uO7Ou!!a2TuK=J4Kay;6&M zYG${rdR@USWCcf?<|_@VT}^cCQq#e8j$^`bOsjsK!`+dz^ZZ(?Tn+q|=|C0rVxg-} z;x_^2IDWX;Q*w? zh$E=iF`)u`h|HHVF2JQk|*;^(O^6r55#yg5MxHU}g^=_SK=CRmz(yYe(u8hz)t$ zTl{{D*scp4Y2#^KWCQgqM|R6w_2(C?_86yGS9iBdJuYxg{f1<2s<#T5C#Av=RLk{G-|eN6`}XNP`cna*9*9GYbTz;?u?-W2(T}10<7QR&d%J)sw0l zs#)T5x$Sg5rPC{lKh!CdPWxDGj{sFikv#Qm zMyOBGEy$Me2G>U?vdmdo0^JY@*#{(99Oe`}ktd)CAcb78!4t-Mg0@f^;J;}I^trLb zpO9TdpGi~Z+FGIAzwAmJvEWVtF*bf9tM!~dai_TWUcOOGj^N0?^Z5)2i7Q1whzS`g< z#L}f{At1mL<+4M@2d?0Ih1>*e!YE!PpOsurYW)-}5PjLBt^G?#>I%=>6YZG~1XFwN z<9>D1S)24E1N;8SURW;T2Khka?T$@Ci~N#M z3s$#|7S*Yi*6dDNX$FXoiBJj?6PyjROtJ~-;2G(~vbzN*D<9zM3qFkUb;_y1;X*-! z+g8@Ph@<Rmu6BayvQ7ZRlqWg)`Q&S5Xo2p+&wohU+zd1 zPhf&*&ZpM*vBmsn@l(5^Dwcpz&+v;%gnVKh{r>2^t5Aq=0jsGO|JuY4Z1900$wN!g>ArtbOelxR3jG#9)uZ|XYnEc z7oN+fQ*OUV|13wF46d4$^=r5fFeNKf4tX)y+Z&MKfc}dFdId&vWLUc1v}nQ=b1Wh= zVxjyg=#Lz1Fl^VX^hn9?S&q99VG!f|8CimcWZpUk2Wf0$8#B09SJS~zK?N@{-|OC} z2_?UR?PM)Qw{YN4{9fu=HaQakH!+c!W(3kbNu{zLX9Kp8HV4WSV zUK|lzc=IRRQ(!2IDpxn#aEB7qHIUfnFCpT&+$IxKUclUuTgacox+5yfiG#1=HUO8T zd#7S@W9L0VRk1Ek>14>CeAvPP@BtP8 zL08KrR(K{IS$2|hcBIdprm;Hn^<nGaxyqUjwxDbe5&$f}`cG*Q0ctK>-C26*47(-U=T ztM(hRO?>Z8oFX|D$21-%hzI1bY;>X8)x!3$sfx(*q5v@U641aSsJzJ+mZQ!6Jj6`j z;Biaa{rQ%%F?K-!J2Id0m<88-I>hPGTQE}N@wh8_T_ix}b#`e`c8feh20kqcq-rN) zS4u|X$RUNIM93N;{Xvr&#Q?U1eOv2>{e9i=Jw43lQ!W|sV zYi|HCRG_pIwj2Tv@;x2|GkatJ_AD^xT*9-zJC$kk3|lDl%A-i2Ba)|I4^RuX+ zj&F$3UA2q2-2E&6eo@JvM*eiWWC|+PAgHaYxIV*IYdK`|1$b<6QKJM%Jrpi^q#t3z zrTY>2mzp9@@HpGj&BHH^4%ec=m6Bx<2V7YeL<)(Uri9Uz-%U9&(7JTZFmdNt zrH)Tv82X7?JbQM?BE+JSjylr7o#cdq-GPAPMS>VW1ye69a4r})N0ufg@W1g`?f!?y zUH91{idtp#Lq#Y3gJC1V&_8pL@1&roLDB$7>_s8if`MxX1R~@zXbZ*F0e`&TO8zc$ zhb6LLiXlD9!cB;tK*^8Yho)23?xMrueLaGiUPMi0Qvp?c5x;k%eVoQ#piuqH>~%UXIg+9mO!GZ65(p`OfI47j=o(cK}L~ewCxI=kId>qM?8YLL|iD}AM zyNfBGYZv*FY>FEKl4o2GVASU$Y@lnT^!RPgCn9m3-7gG8tzH6((sSZ96biTlBsULE z$JRI^xO9ZKFr)^T6;LTV160Pnd2$UG^=MYz zxvw|R`*-%iyS$`b$eFr4>edmE4_3?138@$1X=g+C)BHrD)QGw-JG0 zSvyW~z87|*2`gQ1)$$IEk#kTQb1vNOs!!ru(dDU#SBQx^Pjlf7vRmBd6RS+nv)!|@u z$f(Z$>%H}ex@#YWq4n;OHy4}ABA0wX-Oc+WAdrr1^_lcx4(mG6@Ev-2PrbKpgk!uj znufR24JHCU#Vg{BPZ!pKDLKW^;rBivE!&frPAPh5dCFUO+LG7++hB_QLuvs_x^sbX z2UKH{&actfx>Hj%*cA-bZNyKUxdE&}3->D7r^rS@Vu!;IbY~>7m5i<{)itiojI424)eR0V zmsjGv>q>gtQKGs4oi{u%lnnER9wST9Kqa^9G*PnNI$=9Wll0&Q*=i&Z3bQTG`ebYG zJc~o>z4Agz)EOC%4I}4nW#teg9!Vc(;~jbfS5Za7uOqpaF&5|{y2lJ?mg6mac|ZOa q{1+a1Yp(GU1HDm+McEBKgW&2K|A_-$;YZboXA|)zlw)` int = "%bytes_length" -(** Return the length (number of bytes) of the argument. *) +@ocaml.doc(" Return the length (number of bytes) of the argument. ") +external length: bytes => int = "%bytes_length" -external get : bytes -> int -> char = "%bytes_safe_get" -(** [get s n] returns the byte at index [n] in argument [s]. +@ocaml.doc(" [get s n] returns the byte at index [n] in argument [s]. - Raise [Invalid_argument] if [n] is not a valid index in [s]. *) + Raise [Invalid_argument] if [n] is not a valid index in [s]. ") +external get: (bytes, int) => char = "%bytes_safe_get" -external set : bytes -> int -> char -> unit = "%bytes_safe_set" -(** [set s n c] modifies [s] in place, replacing the byte at index [n] +@ocaml.doc(" [set s n c] modifies [s] in place, replacing the byte at index [n] with [c]. - Raise [Invalid_argument] if [n] is not a valid index in [s]. *) + Raise [Invalid_argument] if [n] is not a valid index in [s]. ") +external set: (bytes, int, char) => unit = "%bytes_safe_set" -external create : int -> bytes = "?create_bytes" -(** [create n] returns a new byte sequence of length [n]. The +@ocaml.doc(" [create n] returns a new byte sequence of length [n]. The sequence is uninitialized and contains arbitrary bytes. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +external create: int => bytes = "?create_bytes" -val make : int -> char -> bytes -(** [make n c] returns a new byte sequence of length [n], filled with +@ocaml.doc(" [make n c] returns a new byte sequence of length [n], filled with the byte [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +let make: (int, char) => bytes -val init : int -> (int -> char) -> bytes -(** [Bytes.init n f] returns a fresh byte sequence of length [n], with +@ocaml.doc(" [Bytes.init n f] returns a fresh byte sequence of length [n], with character [i] initialized to the result of [f i] (in increasing index order). - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +let init: (int, int => char) => bytes -val empty : bytes -(** A byte sequence of size 0. *) +@ocaml.doc(" A byte sequence of size 0. ") +let empty: bytes -val copy : bytes -> bytes -(** Return a new byte sequence that contains the same bytes as the - argument. *) +@ocaml.doc(" Return a new byte sequence that contains the same bytes as the + argument. ") +let copy: bytes => bytes -val of_string : string -> bytes -(** Return a new byte sequence that contains the same bytes as the - given string. *) +@ocaml.doc(" Return a new byte sequence that contains the same bytes as the + given string. ") +let of_string: string => bytes -val to_string : bytes -> string -(** Return a new string that contains the same bytes as the given byte - sequence. *) +@ocaml.doc(" Return a new string that contains the same bytes as the given byte + sequence. ") +let to_string: bytes => string -val sub : bytes -> int -> int -> bytes -(** [sub s start len] returns a new byte sequence of length [len], +@ocaml.doc(" [sub s start len] returns a new byte sequence of length [len], containing the subsequence of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. *) + valid range of [s]. ") +let sub: (bytes, int, int) => bytes -val sub_string : bytes -> int -> int -> string -(** Same as [sub] but return a string instead of a byte sequence. *) +@ocaml.doc(" Same as [sub] but return a string instead of a byte sequence. ") +let sub_string: (bytes, int, int) => string -val extend : bytes -> int -> int -> bytes -(** [extend s left right] returns a new byte sequence that contains +@ocaml.doc(" [extend s left right] returns a new byte sequence that contains the bytes of [s], with [left] uninitialized bytes prepended and [right] uninitialized bytes appended to it. If [left] or [right] is negative, then bytes are removed (instead of appended) from the corresponding side of [s]. Raise [Invalid_argument] if the result length is negative or - longer than {!Sys.max_string_length} bytes. *) + longer than {!Sys.max_string_length} bytes. ") +let extend: (bytes, int, int) => bytes -val fill : bytes -> int -> int -> char -> unit -(** [fill s start len c] modifies [s] in place, replacing [len] +@ocaml.doc(" [fill s start len c] modifies [s] in place, replacing [len] characters with [c], starting at [start]. Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. *) + valid range of [s]. ") +let fill: (bytes, int, int, char) => unit -val blit : bytes -> int -> bytes -> int -> int -> unit -(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence +@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from sequence [src], starting at index [srcoff], to sequence [dst], starting at index [dstoff]. It works correctly even if [src] and [dst] are the same byte sequence, and the source and destination intervals @@ -127,173 +126,173 @@ val blit : bytes -> int -> bytes -> int -> int -> unit Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. *) + do not designate a valid range of [dst]. ") +let blit: (bytes, int, bytes, int, int) => unit -val blit_string : string -> int -> bytes -> int -> int -> unit -(** [blit src srcoff dst dstoff len] copies [len] bytes from string +@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from string [src], starting at index [srcoff], to byte sequence [dst], starting at index [dstoff]. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. *) + do not designate a valid range of [dst]. ") +let blit_string: (string, int, bytes, int, int) => unit -val concat : bytes -> bytes list -> bytes -(** [concat sep sl] concatenates the list of byte sequences [sl], +@ocaml.doc(" [concat sep sl] concatenates the list of byte sequences [sl], inserting the separator byte sequence [sep] between each, and returns the result as a new byte sequence. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. *) + {!Sys.max_string_length} bytes. ") +let concat: (bytes, list) => bytes -val cat : bytes -> bytes -> bytes -(** [cat s1 s2] concatenates [s1] and [s2] and returns the result +@ocaml.doc(" [cat s1 s2] concatenates [s1] and [s2] and returns the result as new byte sequence. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. *) + {!Sys.max_string_length} bytes. ") +let cat: (bytes, bytes) => bytes -val iter : (char -> unit) -> bytes -> unit -(** [iter f s] applies function [f] in turn to all the bytes of [s]. +@ocaml.doc(" [iter f s] applies function [f] in turn to all the bytes of [s]. It is equivalent to [f (get s 0); f (get s 1); ...; f (get s - (length s - 1)); ()]. *) + (length s - 1)); ()]. ") +let iter: (char => unit, bytes) => unit -val iteri : (int -> char -> unit) -> bytes -> unit -(** Same as {!Bytes.iter}, but the function is applied to the index of +@ocaml.doc(" Same as {!Bytes.iter}, but the function is applied to the index of the byte as first argument and the byte itself as second - argument. *) + argument. ") +let iteri: ((int, char) => unit, bytes) => unit -val map : (char -> char) -> bytes -> bytes -(** [map f s] applies function [f] in turn to all the bytes of [s] +@ocaml.doc(" [map f s] applies function [f] in turn to all the bytes of [s] (in increasing index order) and stores the resulting bytes in - a new sequence that is returned as the result. *) + a new sequence that is returned as the result. ") +let map: (char => char, bytes) => bytes -val mapi : (int -> char -> char) -> bytes -> bytes -(** [mapi f s] calls [f] with each character of [s] and its +@ocaml.doc(" [mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the resulting bytes - in a new sequence that is returned as the result. *) + in a new sequence that is returned as the result. ") +let mapi: ((int, char) => char, bytes) => bytes -val trim : bytes -> bytes -(** Return a copy of the argument, without leading and trailing +@ocaml.doc(" Return a copy of the argument, without leading and trailing whitespace. The bytes regarded as whitespace are the ASCII - characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *) + characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. ") +let trim: bytes => bytes -val escaped : bytes -> bytes -(** Return a copy of the argument, with special characters represented +@ocaml.doc(" Return a copy of the argument, with special characters represented by escape sequences, following the lexical conventions of OCaml. All characters outside the ASCII printable range (32..126) are escaped, as well as backslash and double-quote. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. *) + {!Sys.max_string_length} bytes. ") +let escaped: bytes => bytes -val index : bytes -> char -> int -(** [index s c] returns the index of the first occurrence of byte [c] +@ocaml.doc(" [index s c] returns the index of the first occurrence of byte [c] in [s]. - Raise [Not_found] if [c] does not occur in [s]. *) + Raise [Not_found] if [c] does not occur in [s]. ") +let index: (bytes, char) => int -val index_opt: bytes -> char -> int option -(** [index_opt s c] returns the index of the first occurrence of byte [c] +@ocaml.doc(" [index_opt s c] returns the index of the first occurrence of byte [c] in [s] or [None] if [c] does not occur in [s]. - @since 4.05 *) + @since 4.05 ") +let index_opt: (bytes, char) => option -val rindex : bytes -> char -> int -(** [rindex s c] returns the index of the last occurrence of byte [c] +@ocaml.doc(" [rindex s c] returns the index of the last occurrence of byte [c] in [s]. - Raise [Not_found] if [c] does not occur in [s]. *) + Raise [Not_found] if [c] does not occur in [s]. ") +let rindex: (bytes, char) => int -val rindex_opt: bytes -> char -> int option -(** [rindex_opt s c] returns the index of the last occurrence of byte [c] +@ocaml.doc(" [rindex_opt s c] returns the index of the last occurrence of byte [c] in [s] or [None] if [c] does not occur in [s]. - @since 4.05 *) + @since 4.05 ") +let rindex_opt: (bytes, char) => option -val index_from : bytes -> int -> char -> int -(** [index_from s i c] returns the index of the first occurrence of +@ocaml.doc(" [index_from s i c] returns the index of the first occurrence of byte [c] in [s] after position [i]. [Bytes.index s c] is equivalent to [Bytes.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. *) + Raise [Not_found] if [c] does not occur in [s] after position [i]. ") +let index_from: (bytes, int, char) => int -val index_from_opt: bytes -> int -> char -> int option -(** [index_from _opts i c] returns the index of the first occurrence of +@ocaml.doc(" [index_from _opts i c] returns the index of the first occurrence of byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - @since 4.05 *) + @since 4.05 ") +let index_from_opt: (bytes, int, char) => option -val rindex_from : bytes -> int -> char -> int -(** [rindex_from s i c] returns the index of the last occurrence of +@ocaml.doc(" [rindex_from s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1]. [rindex s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") +let rindex_from: (bytes, int, char) => int -val rindex_from_opt: bytes -> int -> char -> int option -(** [rindex_from_opt s i c] returns the index of the last occurrence +@ocaml.doc(" [rindex_from_opt s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1] or [None] if [c] does not occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - @since 4.05 *) + @since 4.05 ") +let rindex_from_opt: (bytes, int, char) => option -val contains : bytes -> char -> bool -(** [contains s c] tests if byte [c] appears in [s]. *) +@ocaml.doc(" [contains s c] tests if byte [c] appears in [s]. ") +let contains: (bytes, char) => bool -val contains_from : bytes -> int -> char -> bool -(** [contains_from s start c] tests if byte [c] appears in [s] after +@ocaml.doc(" [contains_from s start c] tests if byte [c] appears in [s] after position [start]. [contains s c] is equivalent to [contains_from s 0 c]. - Raise [Invalid_argument] if [start] is not a valid position in [s]. *) + Raise [Invalid_argument] if [start] is not a valid position in [s]. ") +let contains_from: (bytes, int, char) => bool -val rcontains_from : bytes -> int -> char -> bool -(** [rcontains_from s stop c] tests if byte [c] appears in [s] before +@ocaml.doc(" [rcontains_from s stop c] tests if byte [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. *) + position in [s]. ") +let rcontains_from: (bytes, int, char) => bool - -val uppercase_ascii : bytes -> bytes -(** Return a copy of the argument, with all lowercase letters +@ocaml.doc(" Return a copy of the argument, with all lowercase letters translated to uppercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let uppercase_ascii: bytes => bytes -val lowercase_ascii : bytes -> bytes -(** Return a copy of the argument, with all uppercase letters +@ocaml.doc(" Return a copy of the argument, with all uppercase letters translated to lowercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let lowercase_ascii: bytes => bytes -val capitalize_ascii : bytes -> bytes -(** Return a copy of the argument, with the first character set to uppercase, +@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let capitalize_ascii: bytes => bytes -val uncapitalize_ascii : bytes -> bytes -(** Return a copy of the argument, with the first character set to lowercase, +@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let uncapitalize_ascii: bytes => bytes +@ocaml.doc(" An alias for the type of byte sequences. ") type t = bytes -(** An alias for the type of byte sequences. *) -val compare: t -> t -> int -(** The comparison function for byte sequences, with the same +@ocaml.doc(" The comparison function for byte sequences, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Bytes] to be passed as - argument to the functors {!Set.Make} and {!Map.Make}. *) + argument to the functors {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int -val equal: t -> t -> bool -(** The equality function for byte sequences. - @since 4.03.0 *) +@ocaml.doc(" The equality function for byte sequences. + @since 4.03.0 ") +let equal: (t, t) => bool -(** {3 Unsafe conversions (for advanced users)} +@@ocaml.text(" {3 Unsafe conversions (for advanced users)} This section describes unsafe, low-level conversion functions between [bytes] and [string]. They do not copy the internal data; @@ -301,14 +300,13 @@ val equal: t -> t -> bool strings provided by the [-safe-string] option. They are available for expert library authors, but for most purposes you should use the always-correct {!Bytes.to_string} and {!Bytes.of_string} instead. -*) +") -val unsafe_to_string : bytes -> string -(** Unsafely convert a byte sequence into a string. +@ocaml.doc(" Unsafely convert a byte sequence into a string. To reason about the use of [unsafe_to_string], it is convenient to - consider an "ownership" discipline. A piece of code that - manipulates some data "owns" it; there are several disjoint ownership + consider an \"ownership\" discipline. A piece of code that + manipulates some data \"owns\" it; there are several disjoint ownership modes, including: - Unique ownership: the data may be accessed and mutated - Shared ownership: the data has several owners, that may only @@ -377,10 +375,10 @@ let bytes_length (s : bytes) = but also higher-order functions: if {!String.length} returned a closure to be called later, [s] should not be mutated until this closure is fully applied and returns ownership. -*) +") +let unsafe_to_string: bytes => string -val unsafe_of_string : string -> bytes -(** Unsafely convert a shared string to a byte sequence that should +@ocaml.doc(" Unsafely convert a shared string to a byte sequence that should not be mutated. The same ownership discipline that makes [unsafe_to_string] @@ -396,19 +394,19 @@ val unsafe_of_string : string -> bytes compiler, so you never uniquely own them. {[ -let incorrect = Bytes.unsafe_of_string "hello" -let s = Bytes.of_string "hello" +let incorrect = Bytes.unsafe_of_string \"hello\" +let s = Bytes.of_string \"hello\" ]} The first declaration is incorrect, because the string literal - ["hello"] could be shared by the compiler with other parts of the + [\"hello\"] could be shared by the compiler with other parts of the program, and mutating [incorrect] is a bug. You must always use the second version, which performs a copy and is thus correct. Assuming unique ownership of strings that are not string literals, but are (partly) built from string literals, is also - incorrect. For example, mutating [unsafe_of_string ("foo" ^ s)] - could mutate the shared string ["foo"] -- assuming a rope-like + incorrect. For example, mutating [unsafe_of_string (\"foo\" ^ s)] + could mutate the shared string [\"foo\"] -- assuming a rope-like representation of strings. More generally, functions operating on strings will assume shared ownership, they do not preserve unique ownership. It is thus incorrect to assume unique ownership of the @@ -420,11 +418,12 @@ let s = Bytes.of_string "hello" low-level programs that manipulate immutable sequences of bytes (for example {!Marshal.from_bytes}) and previously used the [string] type for this purpose. -*) +") +let unsafe_of_string: string => bytes -(**/**) +@@ocaml.text("/*") -(* The following is for system use only. Do not call directly. *) +/* The following is for system use only. Do not call directly. */ -external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get" -external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" +external unsafe_get: (bytes, int) => char = "%bytes_unsafe_get" +external unsafe_set: (bytes, int, char) => unit = "%bytes_unsafe_set" diff --git a/jscomp/stdlib-406/bytesLabels.ml b/jscomp/stdlib-406/bytesLabels.ml deleted file mode 100644 index 496ca01044..0000000000 --- a/jscomp/stdlib-406/bytesLabels.ml +++ /dev/null @@ -1,428 +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. *) -(* *) -(**************************************************************************) - -(* Byte sequence operations *) - -(* WARNING: Some functions in this file are duplicated in string.ml for - efficiency reasons. When you modify the one in this file you need to - modify its duplicate in string.ml. - These functions have a "duplicated" comment above their definition. -*) -external (.!()) : string -> int -> char = "%string_unsafe_get" -external of_small_int_array : - (_ [@bs.as {json|null|json}] ) -> - int array -> string = - "String.fromCharCode.apply" - [@@bs.val] - -external length : bytes -> int = "%bytes_length" -external%private string_length : string -> int = "%string_length" -external get : bytes -> int -> char = "%bytes_safe_get" -external set : bytes -> int -> char -> unit = "%bytes_safe_set" -external create : int -> bytes = "?create_bytes" - -external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get" -external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" -external (.![]) : bytes -> int -> char = "%bytes_unsafe_get" -external (.![]<-) : bytes -> int -> char -> unit = "%bytes_unsafe_set" -external new_uninitialized : int -> bytes = "Array" [@@bs.new] -external to_int_array : bytes -> int array = "%identity" - -let unsafe_fill : bytes -> int -> int -> char -> unit - = fun (s : bytes) i l (c : char) -> - if l > 0 then - for k = i to l + i - 1 do - s.![k] <- c - done - - - - -(** Same as {!Array.prototype.copyWithin} *) -let copyWithin (s1 : bytes) i1 i2 len = - if i1 < i2 then (* nop for i1 = i2 *) - let range_a = length s1 - i2 - 1 in - let range_b = len - 1 in - let range = if range_a > range_b then range_b else range_a in - for j = range downto 0 do - s1.![i2 + j] <- s1.![i1 + j] - done - else if i1 > i2 then - let range_a = length s1 - i1 - 1 in - let range_b = len - 1 in - let range = if range_a > range_b then range_b else range_a in - for k = 0 to range do - s1.![i2 + k] <- s1.![i1 + k] - done - -(* TODO: when the compiler could optimize small function calls, - use high order functions instead -*) -let unsafe_blit (s1:bytes) i1 (s2:bytes) i2 len = - if len > 0 then - if s1 == s2 then - copyWithin s1 i1 i2 len - else - let off1 = length s1 - i1 in - if len <= off1 then - for i = 0 to len - 1 do - s2.![i2 + i] <- s1.![i1 + i] - done - else - begin - for i = 0 to off1 - 1 do - s2.![i2 + i] <- s1.![i1 + i] - done; - for i = off1 to len - 1 do - s2.![i2 + i] <- '\000' - done - end - -let unsafe_blit_string (s1 : string) i1 (s2 : bytes) i2 (len : int ) = - if len > 0 then - let off1 = string_length s1 - i1 in - if len <= off1 then - for i = 0 to len - 1 do - s2.![i2 + i] <- s1.!(i1 + i) - done - else - begin - for i = 0 to off1 - 1 do - s2.![i2 + i] <- s1.!(i1 + i) - done; - for i = off1 to len - 1 do - s2.![i2 + i] <- '\000' - done - end -let string_of_large_bytes (bytes : bytes) i len = - let s = ref "" in - let s_len = ref len in - let seg = 1024 in - if i = 0 && len <= 4 * seg && len = length bytes then - of_small_int_array (to_int_array bytes) - else - begin - let offset = ref 0 in - while s_len.contents > 0 do - let next = if s_len.contents < 1024 then s_len.contents else seg in - let tmp_bytes = new_uninitialized next in - for k = 0 to next - 1 do - tmp_bytes.![k] <- bytes.![k + offset.contents] - done; - s.contents <- s.contents ^ of_small_int_array (to_int_array tmp_bytes); - s_len.contents <- s_len.contents - next ; - offset.contents <- offset.contents + next; - done; - s.contents - end - - -let make n c = - let s = create n in - unsafe_fill s 0 n c; - s - -let init n ~f = - let s = create n in - for i = 0 to n - 1 do - unsafe_set s i (f i) - done; - s - -let empty = create 0 - -let copy s = - let len = length s in - let r = create len in - unsafe_blit s 0 r 0 len; - r - -let to_string (a : bytes) : string = - string_of_large_bytes a 0 (length a) - -let unsafe_to_string = to_string - -(** checkout [Bytes.empty] -- to be inlined? *) -let of_string (s : string) = - let len = string_length s in - let res = new_uninitialized len in - for i = 0 to len - 1 do - res.![i] <- s.!(i) - (* Note that when get a char and convert it to int immedately, should be optimized - should be [s.charCodeAt[i]] - *) - done; - res - -let unsafe_of_string = of_string - -let sub s ~pos:ofs ~len = - if ofs < 0 || len < 0 || ofs > length s - len - then invalid_arg "String.sub / Bytes.sub" - else begin - let r = create len in - unsafe_blit s ofs r 0 len; - r - end - -let sub_string b ~pos:ofs ~len = unsafe_to_string (sub b ~pos:ofs ~len) - -(* addition with an overflow check *) -let (++) a b = - let c = a + b in - match a < 0, b < 0, c < 0 with - | true , true , false - | false, false, true -> invalid_arg "Bytes.extend" (* overflow *) - | _ -> c - -let extend s ~left ~right = - let len = length s ++ left ++ right in - let r = create len in - let (srcoff, dstoff) = if left < 0 then -left, 0 else 0, left in - let cpylen = min (length s - srcoff) (len - dstoff) in - if cpylen > 0 then unsafe_blit s srcoff r dstoff cpylen; - r - -let fill s ~pos:ofs ~len c = - if ofs < 0 || len < 0 || ofs > length s - len - then invalid_arg "String.fill / Bytes.fill" - else unsafe_fill s ofs len c - -let blit ~src:s1 ~src_pos:ofs1 ~dst:s2 ~dst_pos:ofs2 ~len = - if len < 0 || ofs1 < 0 || ofs1 > length s1 - len - || ofs2 < 0 || ofs2 > length s2 - len - then invalid_arg "Bytes.blit" - else unsafe_blit s1 ofs1 s2 ofs2 len - -let blit_string ~src:s1 ~src_pos:ofs1 ~dst:s2 ~dst_pos:ofs2 ~len = - if len < 0 || ofs1 < 0 || ofs1 > string_length s1 - len - || ofs2 < 0 || ofs2 > length s2 - len - then invalid_arg "String.blit / Bytes.blit_string" - else unsafe_blit_string s1 ofs1 s2 ofs2 len - -(* duplicated in string.ml *) -let iter ~f a = - for i = 0 to length a - 1 do f(unsafe_get a i) done - -(* duplicated in string.ml *) -let iteri ~f a = - for i = 0 to length a - 1 do f i (unsafe_get a i) done - -let ensure_ge (x:int) y = if x >= y then x else invalid_arg "Bytes.concat" - -let rec sum_lengths acc seplen = function - | [] -> acc - | hd :: [] -> length hd + acc - | hd :: tl -> sum_lengths (ensure_ge (length hd + seplen + acc) acc) seplen tl - -let rec unsafe_blits dst pos sep seplen = function - [] -> dst - | hd :: [] -> - unsafe_blit hd 0 dst pos (length hd); dst - | hd :: tl -> - unsafe_blit hd 0 dst pos (length hd); - unsafe_blit sep 0 dst (pos + length hd) seplen; - unsafe_blits dst (pos + length hd + seplen) sep seplen tl - -let concat ~sep = function - [] -> empty - | l -> let seplen = length sep in - unsafe_blits - (create (sum_lengths 0 seplen l)) - 0 sep seplen l - -let cat s1 s2 = - let l1 = length s1 in - let l2 = length s2 in - let r = create (l1 + l2) in - unsafe_blit s1 0 r 0 l1; - unsafe_blit s2 0 r l1 l2; - r - - -external char_chr: int -> char = "%identity" - -let is_space = function - | ' ' | '\012' | '\n' | '\r' | '\t' -> true - | _ -> false - -let trim s = - let len = length s in - let i = ref 0 in - while !i < len && is_space (unsafe_get s !i) do - incr i - done; - let j = ref (len - 1) in - while !j >= !i && is_space (unsafe_get s !j) do - decr j - done; - if !j >= !i then - sub s ~pos:!i ~len:(!j - !i + 1) - else - empty - -let escaped s = - let n = ref 0 in - for i = 0 to length s - 1 do - n := !n + - (match unsafe_get s i with - | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2 - | ' ' .. '~' -> 1 - | _ -> 4) - done; - if !n = length s then copy s else begin - let s' = create !n in - n := 0; - for i = 0 to length s - 1 do - begin match unsafe_get s i with - | ('\"' | '\\') as c -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n c - | '\n' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'n' - | '\t' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 't' - | '\r' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'r' - | '\b' -> - unsafe_set s' !n '\\'; incr n; unsafe_set s' !n 'b' - | (' ' .. '~') as c -> unsafe_set s' !n c - | c -> - let a = (c :> int) in - unsafe_set s' !n '\\'; - incr n; - unsafe_set s' !n (char_chr (48 + a / 100)); - incr n; - unsafe_set s' !n (char_chr (48 + (a / 10) mod 10)); - incr n; - unsafe_set s' !n (char_chr (48 + a mod 10)); - end; - incr n - done; - s' - end - -let map ~f s = - let l = length s in - if l = 0 then s else begin - let r = create l in - for i = 0 to l - 1 do unsafe_set r i (f (unsafe_get s i)) done; - r - end - -let mapi ~f s = - let l = length s in - if l = 0 then s else begin - let r = create l in - for i = 0 to l - 1 do unsafe_set r i (f i (unsafe_get s i)) done; - r - end - -let uppercase_ascii s = map ~f:Char.uppercase_ascii s -let lowercase_ascii s = map ~f:Char.lowercase_ascii s - -let apply1 f s = - if length s = 0 then s else begin - let r = copy s in - unsafe_set r 0 (f(unsafe_get s 0)); - r - end - -let capitalize_ascii s = apply1 Char.uppercase_ascii s -let uncapitalize_ascii s = apply1 Char.lowercase_ascii s - -(* duplicated in string.ml *) -let rec index_rec s lim i c = - if i >= lim then raise Not_found else - if unsafe_get s i = c then i else index_rec s lim (i + 1) c - -(* duplicated in string.ml *) -let index s c = index_rec s (length s) 0 c - -(* duplicated in string.ml *) -let rec index_rec_opt s lim i c = - if i >= lim then None else - if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c - -(* duplicated in string.ml *) -let index_opt s c = index_rec_opt s (length s) 0 c - -(* duplicated in string.ml *) -let index_from s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else - index_rec s l i c - -(* duplicated in string.ml *) -let index_from_opt s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else - index_rec_opt s l i c - -(* duplicated in string.ml *) -let rec rindex_rec s i c = - if i < 0 then raise Not_found else - if unsafe_get s i = c then i else rindex_rec s (i - 1) c - -(* duplicated in string.ml *) -let rindex s c = rindex_rec s (length s - 1) c - -(* duplicated in string.ml *) -let rindex_from s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from / Bytes.rindex_from" - else - rindex_rec s i c - -(* duplicated in string.ml *) -let rec rindex_rec_opt s i c = - if i < 0 then None else - if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c - -(* duplicated in string.ml *) -let rindex_opt s c = rindex_rec_opt s (length s - 1) c - -(* duplicated in string.ml *) -let rindex_from_opt s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt" - else - rindex_rec_opt s i c - - -(* duplicated in string.ml *) -let contains_from s i c = - let l = length s in - if i < 0 || i > l then - invalid_arg "String.contains_from / Bytes.contains_from" - else - try ignore (index_rec s l i c); true with Not_found -> false - - -(* duplicated in string.ml *) -let contains s c = contains_from s 0 c - -(* duplicated in string.ml *) -let rcontains_from s i c = - if i < 0 || i >= length s then - invalid_arg "String.rcontains_from / Bytes.rcontains_from" - else - try ignore (rindex_rec s i c); true with Not_found -> false - - -type t = bytes - -let compare (x: t) (y: t) = Pervasives.compare x y -let equal (x : t) (y : t) = x = y - diff --git a/jscomp/stdlib-406/bytesLabels.mli b/jscomp/stdlib-406/bytesLabels.mli deleted file mode 100644 index fbbefcba0e..0000000000 --- a/jscomp/stdlib-406/bytesLabels.mli +++ /dev/null @@ -1,276 +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. *) -(* *) -(**************************************************************************) - -(** Byte sequence operations. - @since 4.02.0 - *) - -external length : bytes -> int = "%bytes_length" -(** Return the length (number of bytes) of the argument. *) - -external get : bytes -> int -> char = "%bytes_safe_get" -(** [get s n] returns the byte at index [n] in argument [s]. - - Raise [Invalid_argument] if [n] is not a valid index in [s]. *) - - -external set : bytes -> int -> char -> unit = "%bytes_safe_set" -(** [set s n c] modifies [s] in place, replacing the byte at index [n] - with [c]. - - Raise [Invalid_argument] if [n] is not a valid index in [s]. *) - -external create : int -> bytes = "?create_bytes" -(** [create n] returns a new byte sequence of length [n]. The - sequence is uninitialized and contains arbitrary bytes. - - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) - -val make : int -> char -> bytes -(** [make n c] returns a new byte sequence of length [n], filled with - the byte [c]. - - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) - -val init : int -> f:(int -> char) -> bytes -(** [init n f] returns a fresh byte sequence of length [n], - with character [i] initialized to the result of [f i]. - - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) - -val empty : bytes -(** A byte sequence of size 0. *) - -val copy : bytes -> bytes -(** Return a new byte sequence that contains the same bytes as the - argument. *) - -val of_string : string -> bytes -(** Return a new byte sequence that contains the same bytes as the - given string. *) - -val to_string : bytes -> string -(** Return a new string that contains the same bytes as the given byte - sequence. *) - -val sub : bytes -> pos:int -> len:int -> bytes -(** [sub s start len] returns a new byte sequence of length [len], - containing the subsequence of [s] that starts at position [start] - and has length [len]. - - Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. *) - -val sub_string : bytes -> pos:int -> len:int -> string -(** Same as [sub] but return a string instead of a byte sequence. *) - -val extend : bytes -> left:int -> right:int -> bytes -(** [extend s left right] returns a new byte sequence that contains - the bytes of [s], with [left] uninitialized bytes prepended and - [right] uninitialized bytes appended to it. If [left] or [right] - is negative, then bytes are removed (instead of appended) from - the corresponding side of [s]. - - Raise [Invalid_argument] if the result length is negative or - longer than {!Sys.max_string_length} bytes. - @since 4.05.0 *) - -val fill : bytes -> pos:int -> len:int -> char -> unit -(** [fill s start len c] modifies [s] in place, replacing [len] - characters with [c], starting at [start]. - - Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. *) - -val blit : - src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int - -> unit -(** [blit src srcoff dst dstoff len] copies [len] bytes from sequence - [src], starting at index [srcoff], to sequence [dst], starting at - index [dstoff]. It works correctly even if [src] and [dst] are the - same byte sequence, and the source and destination intervals - overlap. - - Raise [Invalid_argument] if [srcoff] and [len] do not - designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. *) - -val blit_string : - src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int - -> unit -(** [blit src srcoff dst dstoff len] copies [len] bytes from string - [src], starting at index [srcoff], to byte sequence [dst], - starting at index [dstoff]. - - Raise [Invalid_argument] if [srcoff] and [len] do not - designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. - @since 4.05.0 *) - -val concat : sep:bytes -> bytes list -> bytes -(** [concat sep sl] concatenates the list of byte sequences [sl], - inserting the separator byte sequence [sep] between each, and - returns the result as a new byte sequence. *) - -val cat : bytes -> bytes -> bytes -(** [cat s1 s2] concatenates [s1] and [s2] and returns the result - as new byte sequence. - - Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. - @since 4.05.0 *) - -val iter : f:(char -> unit) -> bytes -> unit -(** [iter f s] applies function [f] in turn to all the bytes of [s]. - It is equivalent to [f (get s 0); f (get s 1); ...; f (get s - (length s - 1)); ()]. *) - -val iteri : f:(int -> char -> unit) -> bytes -> unit -(** Same as {!Bytes.iter}, but the function is applied to the index of - the byte as first argument and the byte itself as second - argument. *) - -val map : f:(char -> char) -> bytes -> bytes -(** [map f s] applies function [f] in turn to all the bytes of [s] and - stores the resulting bytes in a new sequence that is returned as - the result. *) - -val mapi : f:(int -> char -> char) -> bytes -> bytes -(** [mapi f s] calls [f] with each character of [s] and its - index (in increasing index order) and stores the resulting bytes - in a new sequence that is returned as the result. *) - -val trim : bytes -> bytes -(** Return a copy of the argument, without leading and trailing - whitespace. The bytes regarded as whitespace are the ASCII - characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. *) - -val escaped : bytes -> bytes -(** Return a copy of the argument, with special characters represented - by escape sequences, following the lexical conventions of OCaml. *) - -val index : bytes -> char -> int -(** [index s c] returns the index of the first occurrence of byte [c] - in [s]. - - Raise [Not_found] if [c] does not occur in [s]. *) - -val index_opt: bytes -> char -> int option -(** [index_opt s c] returns the index of the first occurrence of byte [c] - in [s] or [None] if [c] does not occur in [s]. - @since 4.05 *) - -val rindex : bytes -> char -> int -(** [rindex s c] returns the index of the last occurrence of byte [c] - in [s]. - - Raise [Not_found] if [c] does not occur in [s]. *) - -val rindex_opt: bytes -> char -> int option -(** [rindex_opt s c] returns the index of the last occurrence of byte [c] - in [s] or [None] if [c] does not occur in [s]. - @since 4.05 *) - -val index_from : bytes -> int -> char -> int -(** [index_from s i c] returns the index of the first occurrence of - byte [c] in [s] after position [i]. [Bytes.index s c] is - equivalent to [Bytes.index_from s 0 c]. - - Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. *) - -val index_from_opt: bytes -> int -> char -> int option -(** [index_from _opts i c] returns the index of the first occurrence of - byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. - [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. - - Raise [Invalid_argument] if [i] is not a valid position in [s]. - @since 4.05 *) - -val rindex_from : bytes -> int -> char -> int -(** [rindex_from s i c] returns the index of the last occurrence of - byte [c] in [s] before position [i+1]. [rindex s c] is equivalent - to [rindex_from s (Bytes.length s - 1) c]. - - Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) - -val rindex_from_opt: bytes -> int -> char -> int option -(** [rindex_from_opt s i c] returns the index of the last occurrence - of byte [c] in [s] before position [i+1] or [None] if [c] does not - occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to - [rindex_from s (Bytes.length s - 1) c]. - - Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - @since 4.05 *) - -val contains : bytes -> char -> bool -(** [contains s c] tests if byte [c] appears in [s]. *) - -val contains_from : bytes -> int -> char -> bool -(** [contains_from s start c] tests if byte [c] appears in [s] after - position [start]. [contains s c] is equivalent to [contains_from - s 0 c]. - - Raise [Invalid_argument] if [start] is not a valid position in [s]. *) - -val rcontains_from : bytes -> int -> char -> bool -(** [rcontains_from s stop c] tests if byte [c] appears in [s] before - position [stop+1]. - - Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. *) - -val uppercase_ascii : bytes -> bytes -(** Return a copy of the argument, with all lowercase letters - translated to uppercase, using the US-ASCII character set. - @since 4.05.0 *) - -val lowercase_ascii : bytes -> bytes -(** Return a copy of the argument, with all uppercase letters - translated to lowercase, using the US-ASCII character set. - @since 4.05.0 *) - -val capitalize_ascii : bytes -> bytes -(** Return a copy of the argument, with the first character set to uppercase, - using the US-ASCII character set. - @since 4.05.0 *) - -val uncapitalize_ascii : bytes -> bytes -(** Return a copy of the argument, with the first character set to lowercase, - using the US-ASCII character set. - @since 4.05.0 *) - -type t = bytes -(** An alias for the type of byte sequences. *) - -val compare: t -> t -> int -(** The comparison function for byte sequences, with the same - specification as {!Pervasives.compare}. Along with the type [t], - this function [compare] allows the module [Bytes] to be passed as - argument to the functors {!Set.Make} and {!Map.Make}. *) - -val equal: t -> t -> bool -(** The equality function for byte sequences. - @since 4.05.0 *) - -(**/**) - -(* The following is for system use only. Do not call directly. *) - -external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get" -external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" -val unsafe_to_string : bytes -> string -val unsafe_of_string : string -> bytes diff --git a/jscomp/stdlib-406/bytesLabels.res b/jscomp/stdlib-406/bytesLabels.res new file mode 100644 index 0000000000000000000000000000000000000000..527d76a20ad3c2eaa73a5c6f868cde6c630f448a GIT binary patch literal 13251 zcmd5@e{b7H61~5T`w&|Jt*Ka6Y@;|_jo3}X7fFw|9lCo%1q>iK<`1eH*H*u)brC9&!4FmRr2p;RwmW5Zo}0l)#9ek&u6XL|L(iLspn~OyM(yxOINEY_n7?%M|*wVAp2#yiwKEkmJx#r~ibi4XCJ}vNEe7 z;jhcHB2U!Md6Jb)rmnKOf#~XBygyQJ^L8erw3y8zOL8p9u9Iv*1r`1;^71k-&!K6P zKn6&Vm$F8L`}z6FkEbtx?5T85&IL>!Z_&L!+_af$GI3I-ss$9Ic#WO^{n?At=chj% zs+ZL~Q`2Rc=xLGE+A*#(l`a=BMoc?mjz%rd$AAo+wxyKHrqevhfrJ~lB5uH8tbU)t zdpFfm&8sw@-iYc|3AfM+mNw_h3{=~Sbj+=J3)fkW0mCux`fUbxd(zJ0t4zge&@D*^ zDyio4tZY?$R$&q@&TDvLnwL2>9B;uu*)@PbEWRF$zlw%~LltSoMqt?v)zPs^W^t{K z)ZlA9FOE9>9nrqC*XQgrP(-MEQ*`Kmg7=n<#{_hRA=yOLjgfZ^Gui&ky)6pnk30S_4LU6-i=y*a|s3Hv37)CR8R&fk_%SK{MQF;j{cv8#ah9>P6 zCqPk~9cuNCt-5OPy`Go|SKlzsF?Y)9ZuJ)sWAKP*3u<@_{ST6J8Fj;;%eKNaZadSs+In zHIUDWKxKi+s^C#$fQ$K&!X}a&c9=j|=TlXvW3{LLWQ;Sjs7uCvj@*Em9bD|HeKV^h zXkWd7xuRyIEm~~Re~LDoK{IRP%mR7x42P%ekE#;v6;11d$Y*K3AU-< zk<0V)y#nT`lpBJ|QM2!4M&8d4Ab3_1#aiNgUp>L7kqQ~NtQI0VCXP6PJVR|rxsJ>8 zY!YK!MX8-}&9zmw9 zV9nLVqgM0)iUMXP#GUe&zVfo^{`Sj1emPWcx&5)Uz)rM4Ia1?dS)|y6+kB3oRI*)k zyO>I_c>u}u%MwnTp?FeN&6366mYX(9(^Ir%(byX+ke^CaU_CU1+=m88(FRA^oiZYweR&e z#^eZ&>^oof0GGHz1bE&H>HxT2Qj~TgGxQo4GK<{iz>m8RMVAXC=RWPcUiJ#Pta03D zvf0RG>uGxqGa`$dXiQ^8RE0%cBkP+T)f5KKH{Et3Sz1;ig6eD<4X_{SeWPJrXGU?= z4QJ;V+}}I+7WXmVB7zY^-+ZGYjbt+M;U>P$HwR1N<5skV%OZDcV>e{e|ns&;3 zQoMG)=q$fd6h)N523%KdND>n1!nEKJ&=HlgLyr$^!FP$=1Z=`6ol0F+vN@^greFc@ z%MO?JPZ6OjI^G@8p7}s9wC664SJ$nvNl!Ac?~m-b+qJk(KG1l-Ws=Z5zRa*XDp_~2 zP-Hr{=+!lPBtZ2_MAm70BPC04cVlU>PBpYXOm8I?rT~ARaMd`uU~`y8I-O97j#D;Y zv^QX71O#5YiVvf5p0avKyfA8T+=?0-ay$!~#hBu#VazSq=vRxDX1caYBA{Hdj!paz z4^5t+1=nVbD7MrnM+~p~dw@^0yYAJ#Xs;xf6*@1ke&CsLEH-$fc6V9uobfb{K1G&( zZ_8gIP)?$B2?}=oC2)(jjgfc7L_C)QM7Xg&=}nj0z)`M z?5TI}Oybtp96ojkgq>uSuAA}_&4)Ziqv1TVodYs^EFGU_jBD9GRuc9qf>$ssA_gdi z*3jI9K1h2AIs1reHZVF^Mpze_yN{d|0BCqLPE%>i=)PKv_8D9_EvmP0E8t7(Gr7DT z?CcC^P(;O90LcWSF;XwjJq?<3$qYBqs<=^qB>d1j9_-xK%WS0d?`e!f60wPKxkmQj zke)Yw!Vc@3+{6+N++{i#DyYy&EC;@KYQmUK#B9cJJe~ue1`kCxZDBj3DYhG-n5|DP=pP&lX$by#x8?3UO$-3 zE~HuBS3C(r8&LeR8c{|WPBO>^)-Zx;Mi{@__yhL%50K?e=;J}lwxQ^$BquE+yNSMCEQ=X>%^F5P2 zRzUzWGD~I5z-yKcu{rf_7^(4i+!k`5CqUHcY;&w$t>w{V;M63+K44{R3opp1ke6je zBP0}PQXxlSiCed^Zdl*f4d27kVU|j*>R37DDV<`1_lbD=e>yEs!AMlXeq}ksMvk>r zR*T>*YofLHW3jbrV5-2x8btzkxoKlNO7*RcpzA+#Y7(r0o{<|w*T`#59zIr}wUxFQ z0ucJUKL}=K9|G*G@}d02uab=x`m-z(lJakFubq~QEa$-m}@<< zx`bp|&m#?z%aNPZ70Z#g7SB1Hd^=k1AX(ec=z0uzY#uN0WVmN|+X)jBuieucmNRxw zE7joxQ7}$n{BSPmvTPUvfq9N2pPv4&~(qjdp_R zK`?0cqUhVdv-CoPWq)t4Yre88usNIqQh3t^9SV{g;U7+3og==CWJrw(hCe<{J=Sbv zs>`+WctM-;xPa{Gmj)Q_5)xMM^r@dSnDkF7{xi0IjiB}FWgss<2W~^nfb&3b43T_n ztfM8@y(qIaLvZf7|2L9{$C*2XUoP-MRuVUODWFMm>LDctbb>xdC&0_NcMIJkCu#J? z?poTrMV881d8>#eUu4~F9Bcbbn>o1KmijIPqWdoF0PZysvAgGZmk^J_L-neD11UDA>T(BumJG8lS)sv&W2 z0s}F#vaMpDPt3yH-D#VS?er+Dkn>3D}V_#&byc>T1}iBHa7XctfTo^3kfpJ5*@Az$A!hCwO_pN+A7*~_K5 z?Z^R4NUYZXtId6ny6q{sq1BdBXD%_7K`wp3Zt8~cnNSzcRu80)a9Gue!?)bV#v-R!4aQPa6_zVCzh=yUzx) zPIopiZh@*#()!gKTXkxvhPXnYx{3IKGuMFCX<^@LyN_(-B(^yGOm}(`>s+x)`AgmE zu~syn5;KW*jCaYJ=j698U;dOw&7kMEbSTG z52;Ve3n5W!WIU$yoV$^gU66E0`Z61D@nvAeibmdyvaf~A(N(lh9?(C>8~ysP0)EBc on#4_hh1V(gawl$zuK8F(s%!kQ1^%P}RU;l(_=~PtRo`s=7mN-Y*#H0l literal 0 HcmV?d00001 diff --git a/jscomp/stdlib-406/bytesLabels.resi b/jscomp/stdlib-406/bytesLabels.resi new file mode 100644 index 0000000000..e519535284 --- /dev/null +++ b/jscomp/stdlib-406/bytesLabels.resi @@ -0,0 +1,271 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Byte sequence operations. + @since 4.02.0 + ") + +@ocaml.doc(" Return the length (number of bytes) of the argument. ") +external length: bytes => int = "%bytes_length" + +@ocaml.doc(" [get s n] returns the byte at index [n] in argument [s]. + + Raise [Invalid_argument] if [n] is not a valid index in [s]. ") +external get: (bytes, int) => char = "%bytes_safe_get" + +@ocaml.doc(" [set s n c] modifies [s] in place, replacing the byte at index [n] + with [c]. + + Raise [Invalid_argument] if [n] is not a valid index in [s]. ") +external set: (bytes, int, char) => unit = "%bytes_safe_set" + +@ocaml.doc(" [create n] returns a new byte sequence of length [n]. The + sequence is uninitialized and contains arbitrary bytes. + + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +external create: int => bytes = "?create_bytes" + +@ocaml.doc(" [make n c] returns a new byte sequence of length [n], filled with + the byte [c]. + + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +let make: (int, char) => bytes + +@ocaml.doc(" [init n f] returns a fresh byte sequence of length [n], + with character [i] initialized to the result of [f i]. + + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +let init: (int, ~f: int => char) => bytes + +@ocaml.doc(" A byte sequence of size 0. ") +let empty: bytes + +@ocaml.doc(" Return a new byte sequence that contains the same bytes as the + argument. ") +let copy: bytes => bytes + +@ocaml.doc(" Return a new byte sequence that contains the same bytes as the + given string. ") +let of_string: string => bytes + +@ocaml.doc(" Return a new string that contains the same bytes as the given byte + sequence. ") +let to_string: bytes => string + +@ocaml.doc(" [sub s start len] returns a new byte sequence of length [len], + containing the subsequence of [s] that starts at position [start] + and has length [len]. + + Raise [Invalid_argument] if [start] and [len] do not designate a + valid range of [s]. ") +let sub: (bytes, ~pos: int, ~len: int) => bytes + +@ocaml.doc(" Same as [sub] but return a string instead of a byte sequence. ") +let sub_string: (bytes, ~pos: int, ~len: int) => string + +@ocaml.doc(" [extend s left right] returns a new byte sequence that contains + the bytes of [s], with [left] uninitialized bytes prepended and + [right] uninitialized bytes appended to it. If [left] or [right] + is negative, then bytes are removed (instead of appended) from + the corresponding side of [s]. + + Raise [Invalid_argument] if the result length is negative or + longer than {!Sys.max_string_length} bytes. + @since 4.05.0 ") +let extend: (bytes, ~left: int, ~right: int) => bytes + +@ocaml.doc(" [fill s start len c] modifies [s] in place, replacing [len] + characters with [c], starting at [start]. + + Raise [Invalid_argument] if [start] and [len] do not designate a + valid range of [s]. ") +let fill: (bytes, ~pos: int, ~len: int, char) => unit + +@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from sequence + [src], starting at index [srcoff], to sequence [dst], starting at + index [dstoff]. It works correctly even if [src] and [dst] are the + same byte sequence, and the source and destination intervals + overlap. + + Raise [Invalid_argument] if [srcoff] and [len] do not + designate a valid range of [src], or if [dstoff] and [len] + do not designate a valid range of [dst]. ") +let blit: (~src: bytes, ~src_pos: int, ~dst: bytes, ~dst_pos: int, ~len: int) => unit + +@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from string + [src], starting at index [srcoff], to byte sequence [dst], + starting at index [dstoff]. + + Raise [Invalid_argument] if [srcoff] and [len] do not + designate a valid range of [src], or if [dstoff] and [len] + do not designate a valid range of [dst]. + @since 4.05.0 ") +let blit_string: (~src: string, ~src_pos: int, ~dst: bytes, ~dst_pos: int, ~len: int) => unit + +@ocaml.doc(" [concat sep sl] concatenates the list of byte sequences [sl], + inserting the separator byte sequence [sep] between each, and + returns the result as a new byte sequence. ") +let concat: (~sep: bytes, list) => bytes + +@ocaml.doc(" [cat s1 s2] concatenates [s1] and [s2] and returns the result + as new byte sequence. + + Raise [Invalid_argument] if the result is longer than + {!Sys.max_string_length} bytes. + @since 4.05.0 ") +let cat: (bytes, bytes) => bytes + +@ocaml.doc(" [iter f s] applies function [f] in turn to all the bytes of [s]. + It is equivalent to [f (get s 0); f (get s 1); ...; f (get s + (length s - 1)); ()]. ") +let iter: (~f: char => unit, bytes) => unit + +@ocaml.doc(" Same as {!Bytes.iter}, but the function is applied to the index of + the byte as first argument and the byte itself as second + argument. ") +let iteri: (~f: (int, char) => unit, bytes) => unit + +@ocaml.doc(" [map f s] applies function [f] in turn to all the bytes of [s] and + stores the resulting bytes in a new sequence that is returned as + the result. ") +let map: (~f: char => char, bytes) => bytes + +@ocaml.doc(" [mapi f s] calls [f] with each character of [s] and its + index (in increasing index order) and stores the resulting bytes + in a new sequence that is returned as the result. ") +let mapi: (~f: (int, char) => char, bytes) => bytes + +@ocaml.doc(" Return a copy of the argument, without leading and trailing + whitespace. The bytes regarded as whitespace are the ASCII + characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. ") +let trim: bytes => bytes + +@ocaml.doc(" Return a copy of the argument, with special characters represented + by escape sequences, following the lexical conventions of OCaml. ") +let escaped: bytes => bytes + +@ocaml.doc(" [index s c] returns the index of the first occurrence of byte [c] + in [s]. + + Raise [Not_found] if [c] does not occur in [s]. ") +let index: (bytes, char) => int + +@ocaml.doc(" [index_opt s c] returns the index of the first occurrence of byte [c] + in [s] or [None] if [c] does not occur in [s]. + @since 4.05 ") +let index_opt: (bytes, char) => option + +@ocaml.doc(" [rindex s c] returns the index of the last occurrence of byte [c] + in [s]. + + Raise [Not_found] if [c] does not occur in [s]. ") +let rindex: (bytes, char) => int + +@ocaml.doc(" [rindex_opt s c] returns the index of the last occurrence of byte [c] + in [s] or [None] if [c] does not occur in [s]. + @since 4.05 ") +let rindex_opt: (bytes, char) => option + +@ocaml.doc(" [index_from s i c] returns the index of the first occurrence of + byte [c] in [s] after position [i]. [Bytes.index s c] is + equivalent to [Bytes.index_from s 0 c]. + + Raise [Invalid_argument] if [i] is not a valid position in [s]. + Raise [Not_found] if [c] does not occur in [s] after position [i]. ") +let index_from: (bytes, int, char) => int + +@ocaml.doc(" [index_from _opts i c] returns the index of the first occurrence of + byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. + [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. + + Raise [Invalid_argument] if [i] is not a valid position in [s]. + @since 4.05 ") +let index_from_opt: (bytes, int, char) => option + +@ocaml.doc(" [rindex_from s i c] returns the index of the last occurrence of + byte [c] in [s] before position [i+1]. [rindex s c] is equivalent + to [rindex_from s (Bytes.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") +let rindex_from: (bytes, int, char) => int + +@ocaml.doc(" [rindex_from_opt s i c] returns the index of the last occurrence + of byte [c] in [s] before position [i+1] or [None] if [c] does not + occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to + [rindex_from s (Bytes.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + @since 4.05 ") +let rindex_from_opt: (bytes, int, char) => option + +@ocaml.doc(" [contains s c] tests if byte [c] appears in [s]. ") +let contains: (bytes, char) => bool + +@ocaml.doc(" [contains_from s start c] tests if byte [c] appears in [s] after + position [start]. [contains s c] is equivalent to [contains_from + s 0 c]. + + Raise [Invalid_argument] if [start] is not a valid position in [s]. ") +let contains_from: (bytes, int, char) => bool + +@ocaml.doc(" [rcontains_from s stop c] tests if byte [c] appears in [s] before + position [stop+1]. + + Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid + position in [s]. ") +let rcontains_from: (bytes, int, char) => bool + +@ocaml.doc(" Return a copy of the argument, with all lowercase letters + translated to uppercase, using the US-ASCII character set. + @since 4.05.0 ") +let uppercase_ascii: bytes => bytes + +@ocaml.doc(" Return a copy of the argument, with all uppercase letters + translated to lowercase, using the US-ASCII character set. + @since 4.05.0 ") +let lowercase_ascii: bytes => bytes + +@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, + using the US-ASCII character set. + @since 4.05.0 ") +let capitalize_ascii: bytes => bytes + +@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, + using the US-ASCII character set. + @since 4.05.0 ") +let uncapitalize_ascii: bytes => bytes + +@ocaml.doc(" An alias for the type of byte sequences. ") +type t = bytes + +@ocaml.doc(" The comparison function for byte sequences, with the same + specification as {!Pervasives.compare}. Along with the type [t], + this function [compare] allows the module [Bytes] to be passed as + argument to the functors {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int + +@ocaml.doc(" The equality function for byte sequences. + @since 4.05.0 ") +let equal: (t, t) => bool + +@@ocaml.text("/*") + +/* The following is for system use only. Do not call directly. */ + +external unsafe_get: (bytes, int) => char = "%bytes_unsafe_get" +external unsafe_set: (bytes, int, char) => unit = "%bytes_unsafe_set" +let unsafe_to_string: bytes => string +let unsafe_of_string: string => bytes diff --git a/jscomp/stdlib-406/callback.ml b/jscomp/stdlib-406/callback.ml deleted file mode 100644 index e48aafa9ee..0000000000 --- a/jscomp/stdlib-406/callback.ml +++ /dev/null @@ -1,20 +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. *) -(* *) -(**************************************************************************) -[@@@bs.config { flags = [|"-bs-no-cross-module-opt" |]}] -(* Registering OCaml values with the C runtime for later callbacks *) - - -let register _ _ = () -let register_exception _ _ = () diff --git a/jscomp/stdlib-406/callback.mli b/jscomp/stdlib-406/callback.mli deleted file mode 100644 index 27c8b5004b..0000000000 --- a/jscomp/stdlib-406/callback.mli +++ /dev/null @@ -1,34 +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. *) -(* *) -(**************************************************************************) - -(** Registering OCaml values with the C runtime. - - This module allows OCaml values to be registered with the C runtime - under a symbolic name, so that C code can later call back registered - OCaml functions, or raise registered OCaml exceptions. -*) - -val register : string -> 'a -> unit -(** [Callback.register n v] registers the value [v] under - the name [n]. C code can later retrieve a handle to [v] - by calling [caml_named_value(n)]. *) - -val register_exception : string -> exn -> unit -(** [Callback.register_exception n exn] registers the - exception contained in the exception value [exn] - under the name [n]. C code can later retrieve a handle to - the exception by calling [caml_named_value(n)]. The exception - value thus obtained is suitable for passing as first argument - to [raise_constant] or [raise_with_arg]. *) diff --git a/jscomp/stdlib-406/callback.res b/jscomp/stdlib-406/callback.res new file mode 100644 index 0000000000..66378892f0 --- /dev/null +++ b/jscomp/stdlib-406/callback.res @@ -0,0 +1,19 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ +@@bs.config({flags: ["-bs-no-cross-module-opt"]}) +/* Registering OCaml values with the C runtime for later callbacks */ + +let register = (_, _) => () +let register_exception = (_, _) => () diff --git a/jscomp/stdlib-406/callback.resi b/jscomp/stdlib-406/callback.resi new file mode 100644 index 0000000000..18db163797 --- /dev/null +++ b/jscomp/stdlib-406/callback.resi @@ -0,0 +1,34 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +" Registering OCaml values with the C runtime. + + This module allows OCaml values to be registered with the C runtime + under a symbolic name, so that C code can later call back registered + OCaml functions, or raise registered OCaml exceptions. +") + +@ocaml.doc(" [Callback.register n v] registers the value [v] under + the name [n]. C code can later retrieve a handle to [v] + by calling [caml_named_value(n)]. ") +let register: (string, 'a) => unit + +@ocaml.doc(" [Callback.register_exception n exn] registers the + exception contained in the exception value [exn] + under the name [n]. C code can later retrieve a handle to + the exception by calling [caml_named_value(n)]. The exception + value thus obtained is suitable for passing as first argument + to [raise_constant] or [raise_with_arg]. ") +let register_exception: (string, exn) => unit diff --git a/jscomp/stdlib-406/camlinternalLazy.ml b/jscomp/stdlib-406/camlinternalLazy.ml deleted file mode 100644 index 2f2f4545b1..0000000000 --- a/jscomp/stdlib-406/camlinternalLazy.ml +++ /dev/null @@ -1,88 +0,0 @@ -(* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * In addition to the permissions granted to you by the LGPL, you may combine - * or link a "work that uses the Library" with a publicly distributed version - * of this file to produce a combined library or application, then distribute - * that combined work under the terms of your choosing, with no requirement - * to comply with the obligations normally placed on you by section 4 of the - * LGPL version 3 (or the corresponding section of a later version of the LGPL - * should you choose to use a later version). - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU Lesser General Public License for more details. - * - * You should have received a copy of the GNU Lesser General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) - - [@@@bs.config { flags = [|"-bs-no-cross-module-opt" |]}] - -(* Internals of forcing lazy values. *) -type 'a t = { - mutable tag : bool [@bs.as "LAZY_DONE"] ; - (* Invariant: name *) - mutable value : 'a [@bs.as "VAL"] - (* its type is ['a] or [unit -> 'a ] *) -} - - -external%private fnToVal : (unit -> 'a [@bs]) -> 'a = "%identity" -external%private valToFn : 'a -> (unit -> 'a [@bs]) = "%identity" -external%private castToConcrete : 'a lazy_t -> 'a t = "%identity" - -let is_val (type a ) (l : a lazy_t) : bool = - (castToConcrete l ).tag - - - -exception Undefined - -let%private forward_with_closure (type a ) (blk : a t) (closure : unit -> a [@bs]) : a = - let result = closure () [@bs] in - blk.value <- result; - blk.tag<- true; - result - - -let%private raise_undefined = (fun [@bs] () -> raise Undefined) - -(* Assume [blk] is a block with tag lazy *) -let%private force_lazy_block (type a ) (blk : a t) : a = - let closure = valToFn blk.value in - blk.value <- fnToVal raise_undefined; - try - forward_with_closure blk closure - with e -> - blk.value <- fnToVal (fun [@bs] () -> raise e); - raise e - - -(* Assume [blk] is a block with tag lazy *) -let%private force_val_lazy_block (type a ) (blk : a t) : a = - let closure = valToFn blk.value in - blk.value <- fnToVal raise_undefined; - forward_with_closure blk closure - - - -let force (type a ) (lzv : a lazy_t) : a = - let lzv = (castToConcrete lzv : _ t) in - if lzv.tag then lzv.value else - force_lazy_block lzv - - - - -let force_val (type a) (lzv : a lazy_t) : a = - let lzv : _ t = castToConcrete lzv in - if lzv.tag then lzv.value else - force_val_lazy_block lzv - - diff --git a/jscomp/stdlib-406/camlinternalLazy.mli b/jscomp/stdlib-406/camlinternalLazy.mli deleted file mode 100644 index e49104a921..0000000000 --- a/jscomp/stdlib-406/camlinternalLazy.mli +++ /dev/null @@ -1,27 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Para, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Run-time support for lazy values. - All functions in this module are for system use only, not for the - casual user. *) - -exception Undefined - -val force : 'a lazy_t -> 'a -(* instrumented by {!Matching} *) - -val force_val : 'a lazy_t -> 'a - -val is_val : 'a lazy_t -> bool \ No newline at end of file diff --git a/jscomp/stdlib-406/camlinternalLazy.res b/jscomp/stdlib-406/camlinternalLazy.res new file mode 100644 index 0000000000..e3727857da --- /dev/null +++ b/jscomp/stdlib-406/camlinternalLazy.res @@ -0,0 +1,92 @@ +/* Copyright (C) 2017 Hongbo Zhang, Authors of ReScript + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * In addition to the permissions granted to you by the LGPL, you may combine + * or link a "work that uses the Library" with a publicly distributed version + * of this file to produce a combined library or application, then distribute + * that combined work under the terms of your choosing, with no requirement + * to comply with the obligations normally placed on you by section 4 of the + * LGPL version 3 (or the corresponding section of a later version of the LGPL + * should you choose to use a later version). + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + +@@bs.config({flags: ["-bs-no-cross-module-opt"]}) + +/* Internals of forcing lazy values. */ +type t<'a> = { + @as("LAZY_DONE") mutable tag: bool, + /* Invariant: name */ + @as("VAL") mutable value: 'a, + /* its type is ['a] or [unit -> 'a ] */ +} + +%%private(external fnToVal: ((. unit) => 'a) => 'a = "%identity") +%%private(external valToFn: 'a => (. unit) => 'a = "%identity") +%%private(external castToConcrete: lazy_t<'a> => t<'a> = "%identity") + +let is_val = (type a, l: lazy_t): bool => castToConcrete(l).tag + +exception Undefined + +%%private( + let forward_with_closure = (type a, blk: t, closure: (. unit) => a): a => { + let result = closure(.) + blk.value = result + blk.tag = true + result + } +) + +%%private(let raise_undefined = (. ()) => raise(Undefined)) + +/* Assume [blk] is a block with tag lazy */ +%%private( + let force_lazy_block = (type a, blk: t): a => { + let closure = valToFn(blk.value) + blk.value = fnToVal(raise_undefined) + try forward_with_closure(blk, closure) catch { + | e => + blk.value = fnToVal((. ()) => raise(e)) + raise(e) + } + } +) + +/* Assume [blk] is a block with tag lazy */ +%%private( + let force_val_lazy_block = (type a, blk: t): a => { + let closure = valToFn(blk.value) + blk.value = fnToVal(raise_undefined) + forward_with_closure(blk, closure) + } +) + +let force = (type a, lzv: lazy_t): a => { + let lzv: t<_> = castToConcrete(lzv) + if lzv.tag { + lzv.value + } else { + force_lazy_block(lzv) + } +} + +let force_val = (type a, lzv: lazy_t): a => { + let lzv: t<_> = castToConcrete(lzv) + if lzv.tag { + lzv.value + } else { + force_val_lazy_block(lzv) + } +} diff --git a/jscomp/stdlib-406/camlinternalLazy.resi b/jscomp/stdlib-406/camlinternalLazy.resi new file mode 100644 index 0000000000..47944ef698 --- /dev/null +++ b/jscomp/stdlib-406/camlinternalLazy.resi @@ -0,0 +1,27 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +" Run-time support for lazy values. + All functions in this module are for system use only, not for the + casual user. ") + +exception Undefined + +let force: lazy_t<'a> => 'a +/* instrumented by {!Matching} */ + +let force_val: lazy_t<'a> => 'a + +let is_val: lazy_t<'a> => bool diff --git a/jscomp/stdlib-406/camlinternalMod.ml b/jscomp/stdlib-406/camlinternalMod.ml deleted file mode 100644 index fb47db8b7a..0000000000 --- a/jscomp/stdlib-406/camlinternalMod.ml +++ /dev/null @@ -1,21 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2004 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -type shape = - | Function - | Lazy - | Class - | Module of shape array - | Value of Obj.t diff --git a/jscomp/stdlib-406/camlinternalMod.mli b/jscomp/stdlib-406/camlinternalMod.mli deleted file mode 100644 index 47bb7266bd..0000000000 --- a/jscomp/stdlib-406/camlinternalMod.mli +++ /dev/null @@ -1,25 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2004 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Run-time support for recursive modules. - All functions in this module are for system use only, not for the - casual user. *) - -type shape = - | Function - | Lazy - | Class - | Module of shape array - | Value of Obj.t diff --git a/jscomp/stdlib-406/camlinternalMod.res b/jscomp/stdlib-406/camlinternalMod.res new file mode 100644 index 0000000000..3bf65c6b40 --- /dev/null +++ b/jscomp/stdlib-406/camlinternalMod.res @@ -0,0 +1,21 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2004 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +type rec shape = + | Function + | Lazy + | Class + | Module(array) + | Value(Obj.t) diff --git a/jscomp/stdlib-406/camlinternalMod.resi b/jscomp/stdlib-406/camlinternalMod.resi new file mode 100644 index 0000000000..b4da437d52 --- /dev/null +++ b/jscomp/stdlib-406/camlinternalMod.resi @@ -0,0 +1,25 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2004 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +" Run-time support for recursive modules. + All functions in this module are for system use only, not for the + casual user. ") + +type rec shape = + | Function + | Lazy + | Class + | Module(array) + | Value(Obj.t) diff --git a/jscomp/stdlib-406/char.ml b/jscomp/stdlib-406/char.ml deleted file mode 100644 index fc0fb0ac7f..0000000000 --- a/jscomp/stdlib-406/char.ml +++ /dev/null @@ -1,76 +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. *) -(* *) -(**************************************************************************) - -(* Character operations *) - -external code: char -> int = "%identity" -external unsafe_chr: int -> char = "%identity" - -let chr n = - if n < 0 || n > 255 then invalid_arg "Char.chr" else unsafe_chr n - -external bytes_create: int -> bytes = "?create_bytes" -external bytes_unsafe_set : bytes -> int -> char -> unit - = "%bytes_unsafe_set" -external unsafe_to_string : bytes -> string = "%bytes_to_string" - -let escaped = function - | '\'' -> "\\'" - | '\\' -> "\\\\" - | '\n' -> "\\n" - | '\t' -> "\\t" - | '\r' -> "\\r" - | '\b' -> "\\b" - | ' ' .. '~' as c -> - let s = bytes_create 1 in - bytes_unsafe_set s 0 c; - unsafe_to_string s - | c -> - let n = code c in - let s = bytes_create 4 in - bytes_unsafe_set s 0 '\\'; - bytes_unsafe_set s 1 (unsafe_chr (48 + n / 100)); - bytes_unsafe_set s 2 (unsafe_chr (48 + (n / 10) mod 10)); - bytes_unsafe_set s 3 (unsafe_chr (48 + n mod 10)); - unsafe_to_string s - -let lowercase c = - if (c >= 'A' && c <= 'Z') - || (c >= '\192' && c <= '\214') - || (c >= '\216' && c <= '\222') - then unsafe_chr(code c + 32) - else c - -let uppercase c = - if (c >= 'a' && c <= 'z') - || (c >= '\224' && c <= '\246') - || (c >= '\248' && c <= '\254') - then unsafe_chr(code c - 32) - else c - -let lowercase_ascii c = - if (c >= 'A' && c <= 'Z') - then unsafe_chr(code c + 32) - else c - -let uppercase_ascii c = - if (c >= 'a' && c <= 'z') - then unsafe_chr(code c - 32) - else c - -type t = char - -let compare c1 c2 = code c1 - code c2 -let equal (c1: t) (c2: t) = compare c1 c2 = 0 diff --git a/jscomp/stdlib-406/char.mli b/jscomp/stdlib-406/char.mli deleted file mode 100644 index 5d5fc03303..0000000000 --- a/jscomp/stdlib-406/char.mli +++ /dev/null @@ -1,72 +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. *) -(* *) -(**************************************************************************) - -(** Character operations. *) - -external code : char -> int = "%identity" -(** Return the ASCII code of the argument. *) - -val chr : int -> char -(** Return the character with the given ASCII code. - Raise [Invalid_argument "Char.chr"] if the argument is - outside the range 0--255. *) - -val escaped : char -> string -(** Return a string representing the given character, - with special characters escaped following the lexical conventions - of OCaml. - All characters outside the ASCII printable range (32..126) are - escaped, as well as backslash, double-quote, and single-quote. *) - -val lowercase : char -> char - [@@ocaml.deprecated "Use Char.lowercase_ascii instead."] -(** Convert the given character to its equivalent lowercase character, - using the ISO Latin-1 (8859-1) character set. - @deprecated Functions operating on Latin-1 character set are deprecated. *) - -val uppercase : char -> char - [@@ocaml.deprecated "Use Char.uppercase_ascii instead."] -(** Convert the given character to its equivalent uppercase character, - using the ISO Latin-1 (8859-1) character set. - @deprecated Functions operating on Latin-1 character set are deprecated. *) - -val lowercase_ascii : char -> char -(** Convert the given character to its equivalent lowercase character, - using the US-ASCII character set. - @since 4.03.0 *) - -val uppercase_ascii : char -> char -(** Convert the given character to its equivalent uppercase character, - using the US-ASCII character set. - @since 4.03.0 *) - -type t = char -(** An alias for the type of characters. *) - -val compare: t -> t -> int -(** The comparison function for characters, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] - allows the module [Char] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) - -val equal: t -> t -> bool -(** The equal function for chars. - @since 4.03.0 *) - -(**/**) - -(* The following is for system use only. Do not call directly. *) - -external unsafe_chr : int -> char = "%identity" diff --git a/jscomp/stdlib-406/char.res b/jscomp/stdlib-406/char.res new file mode 100644 index 0000000000..afc28ae3f1 --- /dev/null +++ b/jscomp/stdlib-406/char.res @@ -0,0 +1,85 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +/* Character operations */ + +external code: char => int = "%identity" +external unsafe_chr: int => char = "%identity" + +let chr = n => + if n < 0 || n > 255 { + invalid_arg("Char.chr") + } else { + unsafe_chr(n) + } + +external bytes_create: int => bytes = "?create_bytes" +external bytes_unsafe_set: (bytes, int, char) => unit = "%bytes_unsafe_set" +external unsafe_to_string: bytes => string = "%bytes_to_string" + +let escaped = param => + switch param { + | '\'' => "\\'" + | '\\' => "\\\\" + | '\n' => "\\n" + | '\t' => "\\t" + | '\r' => "\\r" + | '\b' => "\\b" + | ' ' .. '~' as c => + let s = bytes_create(1) + bytes_unsafe_set(s, 0, c) + unsafe_to_string(s) + | c => + let n = code(c) + let s = bytes_create(4) + bytes_unsafe_set(s, 0, '\\') + bytes_unsafe_set(s, 1, unsafe_chr(48 + n / 100)) + bytes_unsafe_set(s, 2, unsafe_chr(48 + mod(n / 10, 10))) + bytes_unsafe_set(s, 3, unsafe_chr(48 + mod(n, 10))) + unsafe_to_string(s) + } + +let lowercase = c => + if (c >= 'A' && c <= 'Z') || ((c >= 'À' && c <= 'Ö') || c >= 'Ø' && c <= 'Þ') { + unsafe_chr(code(c) + 32) + } else { + c + } + +let uppercase = c => + if (c >= 'a' && c <= 'z') || ((c >= 'à' && c <= 'ö') || c >= 'ø' && c <= 'þ') { + unsafe_chr(code(c) - 32) + } else { + c + } + +let lowercase_ascii = c => + if c >= 'A' && c <= 'Z' { + unsafe_chr(code(c) + 32) + } else { + c + } + +let uppercase_ascii = c => + if c >= 'a' && c <= 'z' { + unsafe_chr(code(c) - 32) + } else { + c + } + +type t = char + +let compare = (c1, c2) => code(c1) - code(c2) +let equal = (c1: t, c2: t) => compare(c1, c2) == 0 diff --git a/jscomp/stdlib-406/char.resi b/jscomp/stdlib-406/char.resi new file mode 100644 index 0000000000..df3e413d52 --- /dev/null +++ b/jscomp/stdlib-406/char.resi @@ -0,0 +1,74 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* OCaml */ + /* */ + /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ + /* */ + /* Copyright 1996 Institut National de Recherche en Informatique et */ + /* en Automatique. */ + /* */ + /* All rights reserved. This file is distributed under the terms of */ + /* the GNU Lesser General Public License version 2.1, with the */ + /* special exception on linking described in the file LICENSE. */ + /* */ + /* ************************************************************************ */ + + " Character operations. " +) + +@ocaml.doc(" Return the ASCII code of the argument. ") +external code: char => int = "%identity" + +@ocaml.doc(" Return the character with the given ASCII code. + Raise [Invalid_argument \"Char.chr\"] if the argument is + outside the range 0--255. ") +let chr: int => char + +@ocaml.doc(" Return a string representing the given character, + with special characters escaped following the lexical conventions + of OCaml. + All characters outside the ASCII printable range (32..126) are + escaped, as well as backslash, double-quote, and single-quote. ") +let escaped: char => string + +@ocaml.deprecated("Use Char.lowercase_ascii instead.") +@ocaml.doc(" Convert the given character to its equivalent lowercase character, + using the ISO Latin-1 (8859-1) character set. + @deprecated Functions operating on Latin-1 character set are deprecated. ") +let lowercase: char => char + +@ocaml.deprecated("Use Char.uppercase_ascii instead.") +@ocaml.doc(" Convert the given character to its equivalent uppercase character, + using the ISO Latin-1 (8859-1) character set. + @deprecated Functions operating on Latin-1 character set are deprecated. ") +let uppercase: char => char + +@ocaml.doc(" Convert the given character to its equivalent lowercase character, + using the US-ASCII character set. + @since 4.03.0 ") +let lowercase_ascii: char => char + +@ocaml.doc(" Convert the given character to its equivalent uppercase character, + using the US-ASCII character set. + @since 4.03.0 ") +let uppercase_ascii: char => char + +@ocaml.doc(" An alias for the type of characters. ") +type t = char + +@ocaml.doc(" The comparison function for characters, with the same specification as + {!Pervasives.compare}. Along with the type [t], this function [compare] + allows the module [Char] to be passed as argument to the functors + {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int + +@ocaml.doc(" The equal function for chars. + @since 4.03.0 ") +let equal: (t, t) => bool + +@@ocaml.text("/*") + +/* The following is for system use only. Do not call directly. */ + +external unsafe_chr: int => char = "%identity" diff --git a/jscomp/stdlib-406/complex.ml b/jscomp/stdlib-406/complex.ml deleted file mode 100644 index 4df53cbadc..0000000000 --- a/jscomp/stdlib-406/complex.ml +++ /dev/null @@ -1,87 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Complex numbers *) - -type t = { re: float; im: float } - -let zero = { re = 0.0; im = 0.0 } -let one = { re = 1.0; im = 0.0 } -let i = { re = 0.0; im = 1.0 } - -let add x y = { re = x.re +. y.re; im = x.im +. y.im } - -let sub x y = { re = x.re -. y.re; im = x.im -. y.im } - -let neg x = { re = -. x.re; im = -. x.im } - -let conj x = { re = x.re; im = -. x.im } - -let mul x y = { re = x.re *. y.re -. x.im *. y.im; - im = x.re *. y.im +. x.im *. y.re } - -let div x y = - if abs_float y.re >= abs_float y.im then - let r = y.im /. y.re in - let d = y.re +. r *. y.im in - { re = (x.re +. r *. x.im) /. d; - im = (x.im -. r *. x.re) /. d } - else - let r = y.re /. y.im in - let d = y.im +. r *. y.re in - { re = (r *. x.re +. x.im) /. d; - im = (r *. x.im -. x.re) /. d } - -let inv x = div one x - -let norm2 x = x.re *. x.re +. x.im *. x.im - -let norm x = - (* Watch out for overflow in computing re^2 + im^2 *) - let r = abs_float x.re and i = abs_float x.im in - if r = 0.0 then i - else if i = 0.0 then r - else if r >= i then - let q = i /. r in r *. sqrt(1.0 +. q *. q) - else - let q = r /. i in i *. sqrt(1.0 +. q *. q) - -let arg x = atan2 x.im x.re - -let polar n a = { re = cos a *. n; im = sin a *. n } - -let sqrt x = - if x.re = 0.0 && x.im = 0.0 then { re = 0.0; im = 0.0 } - else begin - let r = abs_float x.re and i = abs_float x.im in - let w = - if r >= i then begin - let q = i /. r in - sqrt(r) *. sqrt(0.5 *. (1.0 +. sqrt(1.0 +. q *. q))) - end else begin - let q = r /. i in - sqrt(i) *. sqrt(0.5 *. (q +. sqrt(1.0 +. q *. q))) - end in - if x.re >= 0.0 - then { re = w; im = 0.5 *. x.im /. w } - else { re = 0.5 *. i /. w; im = if x.im >= 0.0 then w else -. w } - end - -let exp x = - let e = exp x.re in { re = e *. cos x.im; im = e *. sin x.im } - -let log x = { re = log (norm x); im = atan2 x.im x.re } - -let pow x y = exp (mul y (log x)) diff --git a/jscomp/stdlib-406/complex.mli b/jscomp/stdlib-406/complex.mli deleted file mode 100644 index 2080eccc28..0000000000 --- a/jscomp/stdlib-406/complex.mli +++ /dev/null @@ -1,86 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Complex numbers. - - This module provides arithmetic operations on complex numbers. - Complex numbers are represented by their real and imaginary parts - (cartesian representation). Each part is represented by a - double-precision floating-point number (type [float]). *) - -type t = { re: float; im: float } -(** The type of complex numbers. [re] is the real part and [im] the - imaginary part. *) - -val zero: t -(** The complex number [0]. *) - -val one: t -(** The complex number [1]. *) - -val i: t -(** The complex number [i]. *) - -val neg: t -> t -(** Unary negation. *) - -val conj: t -> t -(** Conjugate: given the complex [x + i.y], returns [x - i.y]. *) - -val add: t -> t -> t -(** Addition *) - -val sub: t -> t -> t -(** Subtraction *) - -val mul: t -> t -> t -(** Multiplication *) - -val inv: t -> t -(** Multiplicative inverse ([1/z]). *) - -val div: t -> t -> t -(** Division *) - -val sqrt: t -> t -(** Square root. The result [x + i.y] is such that [x > 0] or - [x = 0] and [y >= 0]. - This function has a discontinuity along the negative real axis. *) - -val norm2: t -> float -(** Norm squared: given [x + i.y], returns [x^2 + y^2]. *) - -val norm: t -> float -(** Norm: given [x + i.y], returns [sqrt(x^2 + y^2)]. *) - -val arg: t -> float -(** Argument. The argument of a complex number is the angle - in the complex plane between the positive real axis and a line - passing through zero and the number. This angle ranges from - [-pi] to [pi]. This function has a discontinuity along the - negative real axis. *) - -val polar: float -> float -> t -(** [polar norm arg] returns the complex having norm [norm] - and argument [arg]. *) - -val exp: t -> t -(** Exponentiation. [exp z] returns [e] to the [z] power. *) - -val log: t -> t -(** Natural logarithm (in base [e]). *) - -val pow: t -> t -> t -(** Power function. [pow z1 z2] returns [z1] to the [z2] power. *) diff --git a/jscomp/stdlib-406/complex.res b/jscomp/stdlib-406/complex.res new file mode 100644 index 0000000000..4b0561011f --- /dev/null +++ b/jscomp/stdlib-406/complex.res @@ -0,0 +1,112 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +/* Complex numbers */ + +type t = {re: float, im: float} + +let zero = {re: 0.0, im: 0.0} +let one = {re: 1.0, im: 0.0} +let i = {re: 0.0, im: 1.0} + +let add = (x, y) => {re: x.re +. y.re, im: x.im +. y.im} + +let sub = (x, y) => {re: x.re -. y.re, im: x.im -. y.im} + +let neg = x => {re: -.x.re, im: -.x.im} + +let conj = x => {re: x.re, im: -.x.im} + +let mul = (x, y) => { + re: x.re *. y.re -. x.im *. y.im, + im: x.re *. y.im +. x.im *. y.re, +} + +let div = (x, y) => + if abs_float(y.re) >= abs_float(y.im) { + let r = y.im /. y.re + let d = y.re +. r *. y.im + { + re: (x.re +. r *. x.im) /. d, + im: (x.im -. r *. x.re) /. d, + } + } else { + let r = y.re /. y.im + let d = y.im +. r *. y.re + { + re: (r *. x.re +. x.im) /. d, + im: (r *. x.im -. x.re) /. d, + } + } + +let inv = x => div(one, x) + +let norm2 = x => x.re *. x.re +. x.im *. x.im + +let norm = x => { + /* Watch out for overflow in computing re^2 + im^2 */ + let r = abs_float(x.re) + and i = abs_float(x.im) + if r == 0.0 { + i + } else if i == 0.0 { + r + } else if r >= i { + let q = i /. r + r *. sqrt(1.0 +. q *. q) + } else { + let q = r /. i + i *. sqrt(1.0 +. q *. q) + } +} + +let arg = x => atan2(x.im, x.re) + +let polar = (n, a) => {re: cos(a) *. n, im: sin(a) *. n} + +let sqrt = x => + if x.re == 0.0 && x.im == 0.0 { + {re: 0.0, im: 0.0} + } else { + let r = abs_float(x.re) and i = abs_float(x.im) + let w = if r >= i { + let q = i /. r + sqrt(r) *. sqrt(0.5 *. (1.0 +. sqrt(1.0 +. q *. q))) + } else { + let q = r /. i + sqrt(i) *. sqrt(0.5 *. (q +. sqrt(1.0 +. q *. q))) + } + if x.re >= 0.0 { + {re: w, im: 0.5 *. x.im /. w} + } else { + { + re: 0.5 *. i /. w, + im: if x.im >= 0.0 { + w + } else { + -.w + }, + } + } + } + +let exp = x => { + let e = exp(x.re) + {re: e *. cos(x.im), im: e *. sin(x.im)} +} + +let log = x => {re: log(norm(x)), im: atan2(x.im, x.re)} + +let pow = (x, y) => exp(mul(y, log(x))) diff --git a/jscomp/stdlib-406/complex.resi b/jscomp/stdlib-406/complex.resi new file mode 100644 index 0000000000..0a41e97953 --- /dev/null +++ b/jscomp/stdlib-406/complex.resi @@ -0,0 +1,86 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +" Complex numbers. + + This module provides arithmetic operations on complex numbers. + Complex numbers are represented by their real and imaginary parts + (cartesian representation). Each part is represented by a + double-precision floating-point number (type [float]). ") + +@ocaml.doc(" The type of complex numbers. [re] is the real part and [im] the + imaginary part. ") +type t = {re: float, im: float} + +@ocaml.doc(" The complex number [0]. ") +let zero: t + +@ocaml.doc(" The complex number [1]. ") +let one: t + +@ocaml.doc(" The complex number [i]. ") +let i: t + +@ocaml.doc(" Unary negation. ") +let neg: t => t + +@ocaml.doc(" Conjugate: given the complex [x + i.y], returns [x - i.y]. ") +let conj: t => t + +@ocaml.doc(" Addition ") +let add: (t, t) => t + +@ocaml.doc(" Subtraction ") +let sub: (t, t) => t + +@ocaml.doc(" Multiplication ") +let mul: (t, t) => t + +@ocaml.doc(" Multiplicative inverse ([1/z]). ") +let inv: t => t + +@ocaml.doc(" Division ") +let div: (t, t) => t + +@ocaml.doc(" Square root. The result [x + i.y] is such that [x > 0] or + [x = 0] and [y >= 0]. + This function has a discontinuity along the negative real axis. ") +let sqrt: t => t + +@ocaml.doc(" Norm squared: given [x + i.y], returns [x^2 + y^2]. ") +let norm2: t => float + +@ocaml.doc(" Norm: given [x + i.y], returns [sqrt(x^2 + y^2)]. ") +let norm: t => float + +@ocaml.doc(" Argument. The argument of a complex number is the angle + in the complex plane between the positive real axis and a line + passing through zero and the number. This angle ranges from + [-pi] to [pi]. This function has a discontinuity along the + negative real axis. ") +let arg: t => float + +@ocaml.doc(" [polar norm arg] returns the complex having norm [norm] + and argument [arg]. ") +let polar: (float, float) => t + +@ocaml.doc(" Exponentiation. [exp z] returns [e] to the [z] power. ") +let exp: t => t + +@ocaml.doc(" Natural logarithm (in base [e]). ") +let log: t => t + +@ocaml.doc(" Power function. [pow z1 z2] returns [z1] to the [z2] power. ") +let pow: (t, t) => t diff --git a/jscomp/stdlib-406/digest.ml b/jscomp/stdlib-406/digest.ml deleted file mode 100644 index 614b015d33..0000000000 --- a/jscomp/stdlib-406/digest.ml +++ /dev/null @@ -1,66 +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 - then invalid_arg "Digest.substring" - else unsafe_string str ofs len - -let subbytes b ofs len = substring (Bytes.unsafe_to_string b) ofs len - - - -let char_hex n = - Char.unsafe_chr (n + if n < 10 then Char.code '0' else (Char.code 'a' - 10)) - -let to_hex d = - if String.length d <> 16 then invalid_arg "Digest.to_hex"; - let result = Bytes.create 32 in - for i = 0 to 15 do - let x = Char.code d.[i] in - Bytes.unsafe_set result (i*2) (char_hex (x lsr 4)); - Bytes.unsafe_set result (i*2+1) (char_hex (x land 0x0f)); - done; - Bytes.unsafe_to_string result - -let from_hex s = - if String.length s <> 32 then invalid_arg "Digest.from_hex"; - let digit c = - match c with - | '0'..'9' -> Char.code c - Char.code '0' - | 'A'..'F' -> Char.code c - Char.code 'A' + 10 - | 'a'..'f' -> Char.code c - Char.code 'a' + 10 - | _ -> raise (Invalid_argument "Digest.from_hex") - in - let byte i = digit s.[i] lsl 4 + digit s.[i+1] in - let result = Bytes.create 16 in - for i = 0 to 15 do - Bytes.set result i (Char.chr (byte (2 * i))); - done; - Bytes.unsafe_to_string result diff --git a/jscomp/stdlib-406/digest.mli b/jscomp/stdlib-406/digest.mli deleted file mode 100644 index ab8d5d2c5f..0000000000 --- a/jscomp/stdlib-406/digest.mli +++ /dev/null @@ -1,68 +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. -*) - -type t = string -(** The type of digests: 16-character strings. *) - -val compare : t -> t -> int -(** 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 *) - -val equal : t -> t -> bool -(** The equal function for 16-character digest. - @since 4.03.0 *) - -val string : string -> t -(** Return the digest of the given string. *) - -val bytes : bytes -> t -(** Return the digest of the given byte sequence. - @since 4.02.0 *) - -val substring : string -> int -> int -> t -(** [Digest.substring s ofs len] returns the digest of the substring - of [s] starting at index [ofs] and containing [len] characters. *) - -val subbytes : bytes -> 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 *) - - -val to_hex : t -> string -(** Return the printable hexadecimal representation of the given digest. - Raise [Invalid_argument] if the argument is not exactly 16 bytes. - *) - -val from_hex : string -> t -(** 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 *) diff --git a/jscomp/stdlib-406/digest.res b/jscomp/stdlib-406/digest.res new file mode 100644 index 0000000000..d922290395 --- /dev/null +++ b/jscomp/stdlib-406/digest.res @@ -0,0 +1,78 @@ +/* ************************************************************************ */ +/* */ +/* 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 new file mode 100644 index 0000000000..6664e4a701 --- /dev/null +++ b/jscomp/stdlib-406/digest.resi @@ -0,0 +1,67 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. +") + +@ocaml.doc(" The type of digests: 16-character strings. ") +type t = string + +@ocaml.doc(" 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 + +@ocaml.doc(" The equal function for 16-character digest. + @since 4.03.0 ") +let equal: (t, t) => bool + +@ocaml.doc(" Return the digest of the given string. ") +let string: string => t + +@ocaml.doc(" Return the digest of the given byte sequence. + @since 4.02.0 ") +let bytes: bytes => t + +@ocaml.doc(" [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 + +@ocaml.doc(" [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 + +@ocaml.doc(" 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 + +@ocaml.doc(" 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/filename.ml b/jscomp/stdlib-406/filename.ml deleted file mode 100644 index dc0cbfaacd..0000000000 --- a/jscomp/stdlib-406/filename.ml +++ /dev/null @@ -1,233 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Xavier Leroy and Damien Doligez, 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. *) -(* *) -(**************************************************************************) - -let generic_quote quotequote s = - let l = String.length s in - let b = Buffer.create (l + 20) in - Buffer.add_char b '\''; - for i = 0 to l - 1 do - if s.[i] = '\'' - then Buffer.add_string b quotequote - else Buffer.add_char b s.[i] - done; - Buffer.add_char b '\''; - Buffer.contents b - -(* This function implements the Open Group specification found here: - [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html - In step 1 of [[1]], we choose to return "." for empty input. - (for compatibility with previous versions of OCaml) - In step 2, we choose to process "//" normally. - Step 6 is not implemented: we consider that the [suffix] operand is - always absent. Suffixes are handled by [chop_suffix] and [chop_extension]. -*) -let generic_basename is_dir_sep current_dir_name name = - let rec find_end n = - if n < 0 then String.sub name 0 1 - else if is_dir_sep name n then find_end (n - 1) - else find_beg n (n + 1) - and find_beg n p = - if n < 0 then String.sub name 0 p - else if is_dir_sep name n then String.sub name (n + 1) (p - n - 1) - else find_beg (n - 1) p - in - if name = "" - then current_dir_name - else find_end (String.length name - 1) - -(* This function implements the Open Group specification found here: - [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html - In step 6 of [[2]], we choose to process "//" normally. -*) -let generic_dirname is_dir_sep current_dir_name name = - let rec trailing_sep n = - if n < 0 then String.sub name 0 1 - else if is_dir_sep name n then trailing_sep (n - 1) - else base n - and base n = - if n < 0 then current_dir_name - else if is_dir_sep name n then intermediate_sep n - else base (n - 1) - and intermediate_sep n = - if n < 0 then String.sub name 0 1 - else if is_dir_sep name n then intermediate_sep (n - 1) - else String.sub name 0 (n + 1) - in - if name = "" - then current_dir_name - else trailing_sep (String.length name - 1) - -module Unix = struct - let current_dir_name = "." - let parent_dir_name = ".." - let dir_sep = "/" - let is_dir_sep s i = s.[i] = '/' - let is_relative n = String.length n < 1 || n.[0] <> '/' - let is_implicit n = - is_relative n - && (String.length n < 2 || String.sub n 0 2 <> "./") - && (String.length n < 3 || String.sub n 0 3 <> "../") - let check_suffix name suff = - String.length name >= String.length suff && - String.sub name (String.length name - String.length suff) - (String.length suff) = suff - let temp_dir_name = - try Sys.getenv "TMPDIR" with Not_found -> "/tmp" - let quote = generic_quote "'\\''" - let basename = generic_basename is_dir_sep current_dir_name - let dirname = generic_dirname is_dir_sep current_dir_name -end - -module Win32 = struct - let current_dir_name = "." - let parent_dir_name = ".." - let dir_sep = "\\" - let is_dir_sep s i = let c = s.[i] in c = '/' || c = '\\' || c = ':' - let is_relative n = - (String.length n < 1 || n.[0] <> '/') - && (String.length n < 1 || n.[0] <> '\\') - && (String.length n < 2 || n.[1] <> ':') - let is_implicit n = - is_relative n - && (String.length n < 2 || String.sub n 0 2 <> "./") - && (String.length n < 2 || String.sub n 0 2 <> ".\\") - && (String.length n < 3 || String.sub n 0 3 <> "../") - && (String.length n < 3 || String.sub n 0 3 <> "..\\") - let check_suffix name suff = - String.length name >= String.length suff && - (let s = String.sub name (String.length name - String.length suff) - (String.length suff) in - String.lowercase_ascii s = String.lowercase_ascii suff) - let temp_dir_name = - try Sys.getenv "TEMP" with Not_found -> "." - let quote s = - let l = String.length s in - let b = Buffer.create (l + 20) in - Buffer.add_char b '\"'; - let rec loop i = - if i = l then Buffer.add_char b '\"' else - match s.[i] with - | '\"' -> loop_bs 0 i; - | '\\' -> loop_bs 0 i; - | c -> Buffer.add_char b c; loop (i+1); - and loop_bs n i = - if i = l then begin - Buffer.add_char b '\"'; - add_bs n; - end else begin - match s.[i] with - | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1); - | '\\' -> loop_bs (n+1) (i+1); - | _ -> add_bs n; loop i - end - and add_bs n = for _j = 1 to n do Buffer.add_char b '\\'; done - in - loop 0; - Buffer.contents b - let has_drive s = - let is_letter = function - | 'A' .. 'Z' | 'a' .. 'z' -> true - | _ -> false - in - String.length s >= 2 && is_letter s.[0] && s.[1] = ':' - let drive_and_path s = - if has_drive s - then (String.sub s 0 2, String.sub s 2 (String.length s - 2)) - else ("", s) - let dirname s = - let (drive, path) = drive_and_path s in - let dir = generic_dirname is_dir_sep current_dir_name path in - drive ^ dir - let basename s = - let (_drive, path) = drive_and_path s in - generic_basename is_dir_sep current_dir_name path -end - -module Cygwin = struct - let current_dir_name = "." - let parent_dir_name = ".." - let dir_sep = "/" - let is_dir_sep = Win32.is_dir_sep - let is_relative = Win32.is_relative - let is_implicit = Win32.is_implicit - let check_suffix = Win32.check_suffix - let temp_dir_name = Unix.temp_dir_name - let quote = Unix.quote - let basename = generic_basename is_dir_sep current_dir_name - let dirname = generic_dirname is_dir_sep current_dir_name -end - -let (current_dir_name, parent_dir_name, dir_sep, is_dir_sep, - is_relative, is_implicit, check_suffix, temp_dir_name, quote, basename, - dirname) = - match Sys.os_type with - | "Win32" -> - (Win32.current_dir_name, Win32.parent_dir_name, Win32.dir_sep, - Win32.is_dir_sep, - Win32.is_relative, Win32.is_implicit, Win32.check_suffix, - Win32.temp_dir_name, Win32.quote, Win32.basename, Win32.dirname) - | "Cygwin" -> - (Cygwin.current_dir_name, Cygwin.parent_dir_name, Cygwin.dir_sep, - Cygwin.is_dir_sep, - Cygwin.is_relative, Cygwin.is_implicit, Cygwin.check_suffix, - Cygwin.temp_dir_name, Cygwin.quote, Cygwin.basename, Cygwin.dirname) - | _ -> (* normally "Unix" *) - (Unix.current_dir_name, Unix.parent_dir_name, Unix.dir_sep, - Unix.is_dir_sep, - Unix.is_relative, Unix.is_implicit, Unix.check_suffix, - Unix.temp_dir_name, Unix.quote, Unix.basename, Unix.dirname) - -let concat dirname filename = - let l = String.length dirname in - if l = 0 || is_dir_sep dirname (l-1) - then dirname ^ filename - else dirname ^ dir_sep ^ filename - -let chop_suffix name suff = - let n = String.length name - String.length suff in - if n < 0 then invalid_arg "Filename.chop_suffix" else String.sub name 0 n - -let extension_len name = - let rec check i0 i = - if i < 0 || is_dir_sep name i then 0 - else if name.[i] = '.' then check i0 (i - 1) - else String.length name - i0 - in - let rec search_dot i = - if i < 0 || is_dir_sep name i then 0 - else if name.[i] = '.' then check i (i - 1) - else search_dot (i - 1) - in - search_dot (String.length name - 1) - -let extension name = - let l = extension_len name in - if l = 0 then "" else String.sub name (String.length name - l) l - -let chop_extension name = - let l = extension_len name in - if l = 0 then invalid_arg "Filename.chop_extension" - else String.sub name 0 (String.length name - l) - -let remove_extension name = - let l = extension_len name in - if l = 0 then name else String.sub name 0 (String.length name - l) - - -let current_temp_dir_name = ref temp_dir_name - -let set_temp_dir_name s = current_temp_dir_name := s -let get_temp_dir_name () = !current_temp_dir_name - diff --git a/jscomp/stdlib-406/filename.mli b/jscomp/stdlib-406/filename.mli deleted file mode 100644 index 6e28842b2f..0000000000 --- a/jscomp/stdlib-406/filename.mli +++ /dev/null @@ -1,134 +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. *) -(* *) -(**************************************************************************) - -(** Operations on file names. *) - -val current_dir_name : string -(** The conventional name for the current directory (e.g. [.] in Unix). *) - -val parent_dir_name : string -(** The conventional name for the parent of the current directory - (e.g. [..] in Unix). *) - -val dir_sep : string -(** The directory separator (e.g. [/] in Unix). @since 3.11.2 *) - -val concat : string -> string -> string -(** [concat dir file] returns a file name that designates file - [file] in directory [dir]. *) - -val is_relative : string -> bool -(** Return [true] if the file name is relative to the current - directory, [false] if it is absolute (i.e. in Unix, starts - with [/]). *) - -val is_implicit : string -> bool -(** Return [true] if the file name is relative and does not start - with an explicit reference to the current directory ([./] or - [../] in Unix), [false] if it starts with an explicit reference - to the root directory or the current directory. *) - -val check_suffix : string -> string -> bool -(** [check_suffix name suff] returns [true] if the filename [name] - ends with the suffix [suff]. *) - -val chop_suffix : string -> string -> string -(** [chop_suffix name suff] removes the suffix [suff] from - the filename [name]. The behavior is undefined if [name] does not - end with the suffix [suff]. *) - -val extension : string -> string -(** [extension name] is the shortest suffix [ext] of [name0] where: - - - [name0] is the longest suffix of [name] that does not - contain a directory separator; - - [ext] starts with a period; - - [ext] is preceded by at least one non-period character - in [name0]. - - If such a suffix does not exist, [extension name] is the empty - string. - - @since 4.04 -*) - -val remove_extension : string -> string -(** Return the given file name without its extension, as defined - in {!Filename.extension}. If the extension is empty, the function - returns the given file name. - - The following invariant holds for any file name [s]: - - [remove_extension s ^ extension s = s] - - @since 4.04 -*) - -val chop_extension : string -> string -(** Same as {!Filename.remove_extension}, but raise [Invalid_argument] - if the given name has an empty extension. *) - - -val basename : string -> string -(** Split a file name into directory name / base file name. - If [name] is a valid file name, then [concat (dirname name) (basename name)] - returns a file name which is equivalent to [name]. Moreover, - after setting the current directory to [dirname name] (with {!Sys.chdir}), - references to [basename name] (which is a relative file name) - designate the same file as [name] before the call to {!Sys.chdir}. - - This function conforms to the specification of POSIX.1-2008 for the - [basename] utility. *) - -val dirname : string -> string -(** See {!Filename.basename}. - This function conforms to the specification of POSIX.1-2008 for the - [dirname] utility. *) - - -val get_temp_dir_name : unit -> string -(** The name of the temporary directory: - Under Unix, the value of the [TMPDIR] environment variable, or "/tmp" - if the variable is not set. - Under Windows, the value of the [TEMP] environment variable, or "." - if the variable is not set. - The temporary directory can be changed with {!Filename.set_temp_dir_name}. - @since 4.00.0 -*) - -val set_temp_dir_name : string -> unit -(** Change the temporary directory returned by {!Filename.get_temp_dir_name} - and used by {!Filename.temp_file} and {!Filename.open_temp_file}. - @since 4.00.0 -*) - -val temp_dir_name : string - [@@ocaml.deprecated "Use Filename.get_temp_dir_name instead"] -(** The name of the initial temporary directory: - Under Unix, the value of the [TMPDIR] environment variable, or "/tmp" - if the variable is not set. - Under Windows, the value of the [TEMP] environment variable, or "." - if the variable is not set. - @deprecated You should use {!Filename.get_temp_dir_name} instead. - @since 3.09.1 -*) - -val quote : string -> string -(** Return a quoted version of a file name, suitable for use as - one argument in a command line, escaping all meta-characters. - Warning: under Windows, the output is only suitable for use - with programs that follow the standard Windows quoting - conventions. - *) diff --git a/jscomp/stdlib-406/filename.res b/jscomp/stdlib-406/filename.res new file mode 100644 index 0000000000..0dcb014b31 --- /dev/null +++ b/jscomp/stdlib-406/filename.res @@ -0,0 +1,353 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy and Damien Doligez, 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. */ +/* */ +/* ************************************************************************ */ + +let generic_quote = (quotequote, s) => { + let l = String.length(s) + let b = Buffer.create(l + 20) + Buffer.add_char(b, '\'') + for i in 0 to l - 1 { + if String.get(s, i) == '\'' { + Buffer.add_string(b, quotequote) + } else { + Buffer.add_char(b, String.get(s, i)) + } + } + Buffer.add_char(b, '\'') + Buffer.contents(b) +} + +/* This function implements the Open Group specification found here: + [[1]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/basename.html + In step 1 of [[1]], we choose to return "." for empty input. + (for compatibility with previous versions of OCaml) + In step 2, we choose to process "//" normally. + Step 6 is not implemented: we consider that the [suffix] operand is + always absent. Suffixes are handled by [chop_suffix] and [chop_extension]. +*/ +let generic_basename = (is_dir_sep, current_dir_name, name) => { + let rec find_end = n => + if n < 0 { + String.sub(name, 0, 1) + } else if is_dir_sep(name, n) { + find_end(n - 1) + } else { + find_beg(n, n + 1) + } + and find_beg = (n, p) => + if n < 0 { + String.sub(name, 0, p) + } else if is_dir_sep(name, n) { + String.sub(name, n + 1, p - n - 1) + } else { + find_beg(n - 1, p) + } + + if name == "" { + current_dir_name + } else { + find_end(String.length(name) - 1) + } +} + +/* This function implements the Open Group specification found here: + [[2]] http://pubs.opengroup.org/onlinepubs/9699919799/utilities/dirname.html + In step 6 of [[2]], we choose to process "//" normally. +*/ +let generic_dirname = (is_dir_sep, current_dir_name, name) => { + let rec trailing_sep = n => + if n < 0 { + String.sub(name, 0, 1) + } else if is_dir_sep(name, n) { + trailing_sep(n - 1) + } else { + base(n) + } + and base = n => + if n < 0 { + current_dir_name + } else if is_dir_sep(name, n) { + intermediate_sep(n) + } else { + base(n - 1) + } + and intermediate_sep = n => + if n < 0 { + String.sub(name, 0, 1) + } else if is_dir_sep(name, n) { + intermediate_sep(n - 1) + } else { + String.sub(name, 0, n + 1) + } + + if name == "" { + current_dir_name + } else { + trailing_sep(String.length(name) - 1) + } +} + +module Unix = { + let current_dir_name = "." + let parent_dir_name = ".." + let dir_sep = "/" + let is_dir_sep = (s, i) => String.get(s, i) == '/' + let is_relative = n => String.length(n) < 1 || String.get(n, 0) != '/' + let is_implicit = n => + is_relative(n) && + ((String.length(n) < 2 || String.sub(n, 0, 2) != "./") && + (String.length(n) < 3 || String.sub(n, 0, 3) != "../")) + let check_suffix = (name, suff) => + String.length(name) >= String.length(suff) && + String.sub(name, String.length(name) - String.length(suff), String.length(suff)) == suff + let temp_dir_name = try Sys.getenv("TMPDIR") catch { + | Not_found => "/tmp" + } + let quote = generic_quote("'\\''") + let basename = generic_basename(is_dir_sep, current_dir_name) + let dirname = generic_dirname(is_dir_sep, current_dir_name) +} + +module Win32 = { + let current_dir_name = "." + let parent_dir_name = ".." + let dir_sep = "\\" + let is_dir_sep = (s, i) => { + let c = String.get(s, i) + c == '/' || (c == '\\' || c == ':') + } + let is_relative = n => + (String.length(n) < 1 || String.get(n, 0) != '/') && + ((String.length(n) < 1 || String.get(n, 0) != '\\') && + (String.length(n) < 2 || String.get(n, 1) != ':')) + let is_implicit = n => + is_relative(n) && + ((String.length(n) < 2 || String.sub(n, 0, 2) != "./") && + ((String.length(n) < 2 || String.sub(n, 0, 2) != ".\\") && + ((String.length(n) < 3 || String.sub(n, 0, 3) != "../") && + (String.length(n) < 3 || String.sub(n, 0, 3) != "..\\")))) + let check_suffix = (name, suff) => + String.length(name) >= String.length(suff) && { + let s = String.sub(name, String.length(name) - String.length(suff), String.length(suff)) + String.lowercase_ascii(s) == String.lowercase_ascii(suff) + } + let temp_dir_name = try Sys.getenv("TEMP") catch { + | Not_found => "." + } + let quote = s => { + let l = String.length(s) + let b = Buffer.create(l + 20) + Buffer.add_char(b, '"') + let rec loop = i => + if i == l { + Buffer.add_char(b, '"') + } else { + switch String.get(s, i) { + | '"' => loop_bs(0, i) + | '\\' => loop_bs(0, i) + | c => + Buffer.add_char(b, c) + loop(i + 1) + } + } + and loop_bs = (n, i) => + if i == l { + Buffer.add_char(b, '"') + add_bs(n) + } else { + switch String.get(s, i) { + | '"' => + add_bs(2 * n + 1) + Buffer.add_char(b, '"') + loop(i + 1) + | '\\' => loop_bs(n + 1, i + 1) + | _ => + add_bs(n) + loop(i) + } + } + and add_bs = n => + for _j in 1 to n { + Buffer.add_char(b, '\\') + } + + loop(0) + Buffer.contents(b) + } + let has_drive = s => { + let is_letter = param => + switch param { + | 'A' .. 'Z' | 'a' .. 'z' => true + | _ => false + } + + String.length(s) >= 2 && (is_letter(String.get(s, 0)) && String.get(s, 1) == ':') + } + let drive_and_path = s => + if has_drive(s) { + (String.sub(s, 0, 2), String.sub(s, 2, String.length(s) - 2)) + } else { + ("", s) + } + let dirname = s => { + let (drive, path) = drive_and_path(s) + let dir = generic_dirname(is_dir_sep, current_dir_name, path) + drive ++ dir + } + let basename = s => { + let (_drive, path) = drive_and_path(s) + generic_basename(is_dir_sep, current_dir_name, path) + } +} + +module Cygwin = { + let current_dir_name = "." + let parent_dir_name = ".." + let dir_sep = "/" + let is_dir_sep = Win32.is_dir_sep + let is_relative = Win32.is_relative + let is_implicit = Win32.is_implicit + let check_suffix = Win32.check_suffix + let temp_dir_name = Unix.temp_dir_name + let quote = Unix.quote + let basename = generic_basename(is_dir_sep, current_dir_name) + let dirname = generic_dirname(is_dir_sep, current_dir_name) +} + +let ( + current_dir_name, + parent_dir_name, + dir_sep, + is_dir_sep, + is_relative, + is_implicit, + check_suffix, + temp_dir_name, + quote, + basename, + dirname, +) = switch Sys.os_type { +| "Win32" => ( + Win32.current_dir_name, + Win32.parent_dir_name, + Win32.dir_sep, + Win32.is_dir_sep, + Win32.is_relative, + Win32.is_implicit, + Win32.check_suffix, + Win32.temp_dir_name, + Win32.quote, + Win32.basename, + Win32.dirname, + ) +| "Cygwin" => ( + Cygwin.current_dir_name, + Cygwin.parent_dir_name, + Cygwin.dir_sep, + Cygwin.is_dir_sep, + Cygwin.is_relative, + Cygwin.is_implicit, + Cygwin.check_suffix, + Cygwin.temp_dir_name, + Cygwin.quote, + Cygwin.basename, + Cygwin.dirname, + ) +| _ => /* normally "Unix" */ + ( + Unix.current_dir_name, + Unix.parent_dir_name, + Unix.dir_sep, + Unix.is_dir_sep, + Unix.is_relative, + Unix.is_implicit, + Unix.check_suffix, + Unix.temp_dir_name, + Unix.quote, + Unix.basename, + Unix.dirname, + ) +} + +let concat = (dirname, filename) => { + let l = String.length(dirname) + if l == 0 || is_dir_sep(dirname, l - 1) { + dirname ++ filename + } else { + dirname ++ (dir_sep ++ filename) + } +} + +let chop_suffix = (name, suff) => { + let n = String.length(name) - String.length(suff) + if n < 0 { + invalid_arg("Filename.chop_suffix") + } else { + String.sub(name, 0, n) + } +} + +let extension_len = name => { + let rec check = (i0, i) => + if i < 0 || is_dir_sep(name, i) { + 0 + } else if String.get(name, i) == '.' { + check(i0, i - 1) + } else { + String.length(name) - i0 + } + + let rec search_dot = i => + if i < 0 || is_dir_sep(name, i) { + 0 + } else if String.get(name, i) == '.' { + check(i, i - 1) + } else { + search_dot(i - 1) + } + + search_dot(String.length(name) - 1) +} + +let extension = name => { + let l = extension_len(name) + if l == 0 { + "" + } else { + String.sub(name, String.length(name) - l, l) + } +} + +let chop_extension = name => { + let l = extension_len(name) + if l == 0 { + invalid_arg("Filename.chop_extension") + } else { + String.sub(name, 0, String.length(name) - l) + } +} + +let remove_extension = name => { + let l = extension_len(name) + if l == 0 { + name + } else { + String.sub(name, 0, String.length(name) - l) + } +} + +let current_temp_dir_name = ref(temp_dir_name) + +let set_temp_dir_name = s => current_temp_dir_name := s +let get_temp_dir_name = () => current_temp_dir_name.contents diff --git a/jscomp/stdlib-406/filename.resi b/jscomp/stdlib-406/filename.resi new file mode 100644 index 0000000000..284e54891c --- /dev/null +++ b/jscomp/stdlib-406/filename.resi @@ -0,0 +1,134 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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. */ + /* */ + /* ************************************************************************ */ + + " Operations on file names. " +) + +@ocaml.doc(" The conventional name for the current directory (e.g. [.] in Unix). ") +let current_dir_name: string + +@ocaml.doc(" The conventional name for the parent of the current directory + (e.g. [..] in Unix). ") +let parent_dir_name: string + +@ocaml.doc(" The directory separator (e.g. [/] in Unix). @since 3.11.2 ") +let dir_sep: string + +@ocaml.doc(" [concat dir file] returns a file name that designates file + [file] in directory [dir]. ") +let concat: (string, string) => string + +@ocaml.doc(" Return [true] if the file name is relative to the current + directory, [false] if it is absolute (i.e. in Unix, starts + with [/]). ") +let is_relative: string => bool + +@ocaml.doc(" Return [true] if the file name is relative and does not start + with an explicit reference to the current directory ([./] or + [../] in Unix), [false] if it starts with an explicit reference + to the root directory or the current directory. ") +let is_implicit: string => bool + +@ocaml.doc(" [check_suffix name suff] returns [true] if the filename [name] + ends with the suffix [suff]. ") +let check_suffix: (string, string) => bool + +@ocaml.doc(" [chop_suffix name suff] removes the suffix [suff] from + the filename [name]. The behavior is undefined if [name] does not + end with the suffix [suff]. ") +let chop_suffix: (string, string) => string + +@ocaml.doc(" [extension name] is the shortest suffix [ext] of [name0] where: + + - [name0] is the longest suffix of [name] that does not + contain a directory separator; + - [ext] starts with a period; + - [ext] is preceded by at least one non-period character + in [name0]. + + If such a suffix does not exist, [extension name] is the empty + string. + + @since 4.04 +") +let extension: string => string + +@ocaml.doc(" Return the given file name without its extension, as defined + in {!Filename.extension}. If the extension is empty, the function + returns the given file name. + + The following invariant holds for any file name [s]: + + [remove_extension s ^ extension s = s] + + @since 4.04 +") +let remove_extension: string => string + +@ocaml.doc(" Same as {!Filename.remove_extension}, but raise [Invalid_argument] + if the given name has an empty extension. ") +let chop_extension: string => string + +@ocaml.doc(" Split a file name into directory name / base file name. + If [name] is a valid file name, then [concat (dirname name) (basename name)] + returns a file name which is equivalent to [name]. Moreover, + after setting the current directory to [dirname name] (with {!Sys.chdir}), + references to [basename name] (which is a relative file name) + designate the same file as [name] before the call to {!Sys.chdir}. + + This function conforms to the specification of POSIX.1-2008 for the + [basename] utility. ") +let basename: string => string + +@ocaml.doc(" See {!Filename.basename}. + This function conforms to the specification of POSIX.1-2008 for the + [dirname] utility. ") +let dirname: string => string + +@ocaml.doc(" The name of the temporary directory: + Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" + if the variable is not set. + Under Windows, the value of the [TEMP] environment variable, or \".\" + if the variable is not set. + The temporary directory can be changed with {!Filename.set_temp_dir_name}. + @since 4.00.0 +") +let get_temp_dir_name: unit => string + +@ocaml.doc(" Change the temporary directory returned by {!Filename.get_temp_dir_name} + and used by {!Filename.temp_file} and {!Filename.open_temp_file}. + @since 4.00.0 +") +let set_temp_dir_name: string => unit + +@ocaml.deprecated("Use Filename.get_temp_dir_name instead") +@ocaml.doc(" The name of the initial temporary directory: + Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" + if the variable is not set. + Under Windows, the value of the [TEMP] environment variable, or \".\" + if the variable is not set. + @deprecated You should use {!Filename.get_temp_dir_name} instead. + @since 3.09.1 +") +let temp_dir_name: string + +@ocaml.doc(" Return a quoted version of a file name, suitable for use as + one argument in a command line, escaping all meta-characters. + Warning: under Windows, the output is only suitable for use + with programs that follow the standard Windows quoting + conventions. + ") +let quote: string => string diff --git a/jscomp/stdlib-406/genlex.ml b/jscomp/stdlib-406/genlex.ml deleted file mode 100644 index b015bb95aa..0000000000 --- a/jscomp/stdlib-406/genlex.ml +++ /dev/null @@ -1,201 +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. *) -(* *) -(**************************************************************************) - -type token = - Kwd of string - | Ident of string - | Int of int - | Float of float - | String of string - | Char of char - -(* The string buffering machinery *) - -let initial_buffer = Bytes.create 32 - -let buffer = ref initial_buffer -let bufpos = ref 0 - -let reset_buffer () = buffer := initial_buffer; bufpos := 0 - -let store c = - if !bufpos >= Bytes.length !buffer then begin - let newbuffer = Bytes.create (2 * !bufpos) in - Bytes.blit !buffer 0 newbuffer 0 !bufpos; - buffer := newbuffer - end; - Bytes.set !buffer !bufpos c; - incr bufpos - -let get_string () = - let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s - -(* The lexer *) - -let make_lexer keywords = - let kwd_table = Hashtbl.create 17 in - List.iter (fun s -> Hashtbl.add kwd_table s (Kwd s)) keywords; - let ident_or_keyword id = - try Hashtbl.find kwd_table id with - Not_found -> Ident id - and keyword_or_error c = - let s = String.make 1 c in - try Hashtbl.find kwd_table s with - Not_found -> raise (Stream.Error ("Illegal character " ^ s)) - in - let rec next_token (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some (' ' | '\010' | '\013' | '\009' | '\026' | '\012') -> - Stream.junk strm__; next_token strm__ - | Some ('A'..'Z' | 'a'..'z' | '_' | '\192'..'\255' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store c; ident s - | Some - ('!' | '%' | '&' | '$' | '#' | '+' | '/' | ':' | '<' | '=' | '>' | - '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store c; ident2 s - | Some ('0'..'9' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store c; number s - | Some '\'' -> - Stream.junk strm__; - let c = - try char strm__ with - Stream.Failure -> raise (Stream.Error "") - in - begin match Stream.peek strm__ with - Some '\'' -> Stream.junk strm__; Some (Char c) - | _ -> raise (Stream.Error "") - end - | Some '\"' -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); Some (String (string s)) - | Some '-' -> Stream.junk strm__; neg_number strm__ - | Some '(' -> Stream.junk strm__; maybe_comment strm__ - | Some c -> Stream.junk strm__; Some (keyword_or_error c) - | _ -> None - and ident (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some - ('A'..'Z' | 'a'..'z' | '\192'..'\255' | '0'..'9' | '_' | '\'' as c) -> - Stream.junk strm__; let s = strm__ in store c; ident s - | _ -> Some (ident_or_keyword (get_string ())) - and ident2 (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some - ('!' | '%' | '&' | '$' | '#' | '+' | '-' | '/' | ':' | '<' | '=' | - '>' | '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> - Stream.junk strm__; let s = strm__ in store c; ident2 s - | _ -> Some (ident_or_keyword (get_string ())) - and neg_number (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; - let s = strm__ in reset_buffer (); store '-'; store c; number s - | _ -> let s = strm__ in reset_buffer (); store '-'; ident2 s - and number (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; let s = strm__ in store c; number s - | Some '.' -> - Stream.junk strm__; let s = strm__ in store '.'; decimal_part s - | Some ('e' | 'E') -> - Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s - | _ -> Some (Int (int_of_string (get_string ()))) - and decimal_part (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; let s = strm__ in store c; decimal_part s - | Some ('e' | 'E') -> - Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s - | _ -> Some (Float (float_of_string (get_string ()))) - and exponent_part (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('+' | '-' as c) -> - Stream.junk strm__; let s = strm__ in store c; end_exponent_part s - | _ -> end_exponent_part strm__ - and end_exponent_part (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ('0'..'9' as c) -> - Stream.junk strm__; let s = strm__ in store c; end_exponent_part s - | _ -> Some (Float (float_of_string (get_string ()))) - and string (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\"' -> Stream.junk strm__; get_string () - | Some '\\' -> - Stream.junk strm__; - let c = - try escape strm__ with - Stream.Failure -> raise (Stream.Error "") - in - let s = strm__ in store c; string s - | Some c -> Stream.junk strm__; let s = strm__ in store c; string s - | _ -> raise Stream.Failure - and char (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '\\' -> - Stream.junk strm__; - begin try escape strm__ with - Stream.Failure -> raise (Stream.Error "") - end - | Some c -> Stream.junk strm__; c - | _ -> raise Stream.Failure - and escape (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some 'n' -> Stream.junk strm__; '\n' - | Some 'r' -> Stream.junk strm__; '\r' - | Some 't' -> Stream.junk strm__; '\t' - | Some ('0'..'9' as c1) -> - Stream.junk strm__; - begin match Stream.peek strm__ with - Some ('0'..'9' as c2) -> - Stream.junk strm__; - begin match Stream.peek strm__ with - Some ('0'..'9' as c3) -> - Stream.junk strm__; - Char.chr - ((Char.code c1 - 48) * 100 + (Char.code c2 - 48) * 10 + - (Char.code c3 - 48)) - | _ -> raise (Stream.Error "") - end - | _ -> raise (Stream.Error "") - end - | Some c -> Stream.junk strm__; c - | _ -> raise Stream.Failure - and maybe_comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '*' -> - Stream.junk strm__; let s = strm__ in comment s; next_token s - | _ -> Some (keyword_or_error '(') - and comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '(' -> Stream.junk strm__; maybe_nested_comment strm__ - | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ - | Some _ -> Stream.junk strm__; comment strm__ - | _ -> raise Stream.Failure - and maybe_nested_comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s - | Some _ -> Stream.junk strm__; comment strm__ - | _ -> raise Stream.Failure - and maybe_end_comment (strm__ : _ Stream.t) = - match Stream.peek strm__ with - Some ')' -> Stream.junk strm__; () - | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ - | Some _ -> Stream.junk strm__; comment strm__ - | _ -> raise Stream.Failure - in - fun input -> Stream.from (fun _count -> next_token input) diff --git a/jscomp/stdlib-406/genlex.mli b/jscomp/stdlib-406/genlex.mli deleted file mode 100644 index 473949269a..0000000000 --- a/jscomp/stdlib-406/genlex.mli +++ /dev/null @@ -1,73 +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. *) -(* *) -(**************************************************************************) - -(** A generic lexical analyzer. - - - This module implements a simple 'standard' lexical analyzer, presented - as a function from character streams to token streams. It implements - roughly the lexical conventions of OCaml, but is parameterized by the - set of keywords of your language. - - - Example: a lexer suitable for a desk calculator is obtained by - {[ let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] ]} - - The associated parser would be a function from [token stream] - to, for instance, [int], and would have rules such as: - - {[ - let rec parse_expr = parser - | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2 - and parse_atom = parser - | [< 'Int n >] -> n - | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n - and parse_remainder n1 = parser - | [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2 - | [< >] -> n1 - ]} - - One should notice that the use of the [parser] keyword and associated - notation for streams are only available through camlp4 extensions. This - means that one has to preprocess its sources {i e. g.} by using the - ["-pp"] command-line switch of the compilers. -*) - -(** The type of tokens. The lexical classes are: [Int] and [Float] - for integer and floating-point numbers; [String] for - string literals, enclosed in double quotes; [Char] for - character literals, enclosed in single quotes; [Ident] for - identifiers (either sequences of letters, digits, underscores - and quotes, or sequences of 'operator characters' such as - [+], [*], etc); and [Kwd] for keywords (either identifiers or - single 'special characters' such as [(], [}], etc). *) -type token = - Kwd of string - | Ident of string - | Int of int - | Float of float - | String of string - | Char of char - -val make_lexer : string list -> char Stream.t -> token Stream.t -(** Construct the lexer function. The first argument is the list of - keywords. An identifier [s] is returned as [Kwd s] if [s] - belongs to this list, and as [Ident s] otherwise. - A special character [s] is returned as [Kwd s] if [s] - belongs to this list, and cause a lexical error (exception - {!Stream.Error} with the offending lexeme as its parameter) otherwise. - Blanks and newlines are skipped. Comments delimited by [(*] and [*)] - are skipped as well, and can be nested. A {!Stream.Failure} exception - is raised if end of stream is unexpectedly reached.*) diff --git a/jscomp/stdlib-406/genlex.res b/jscomp/stdlib-406/genlex.res new file mode 100644 index 0000000000..bb6ef2409a --- /dev/null +++ b/jscomp/stdlib-406/genlex.res @@ -0,0 +1,353 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +type token = + | Kwd(string) + | Ident(string) + | Int(int) + | Float(float) + | String(string) + | Char(char) + +/* The string buffering machinery */ + +let initial_buffer = Bytes.create(32) + +let buffer = ref(initial_buffer) +let bufpos = ref(0) + +let reset_buffer = () => { + buffer := initial_buffer + bufpos := 0 +} + +let store = c => { + if bufpos.contents >= Bytes.length(buffer.contents) { + let newbuffer = Bytes.create(2 * bufpos.contents) + Bytes.blit(buffer.contents, 0, newbuffer, 0, bufpos.contents) + buffer := newbuffer + } + Bytes.set(buffer.contents, bufpos.contents, c) + incr(bufpos) +} + +let get_string = () => { + let s = Bytes.sub_string(buffer.contents, 0, bufpos.contents) + buffer := initial_buffer + s +} + +/* The lexer */ + +let make_lexer = keywords => { + let kwd_table = Hashtbl.create(17) + List.iter(s => Hashtbl.add(kwd_table, s, Kwd(s)), keywords) + let ident_or_keyword = id => + try Hashtbl.find(kwd_table, id) catch { + | Not_found => Ident(id) + } + and keyword_or_error = c => { + let s = String.make(1, c) + try Hashtbl.find(kwd_table, s) catch { + | Not_found => raise(Stream.Error("Illegal character " ++ s)) + } + } + + let rec next_token = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some(' ' | '\n' | '\r' | '\t' | '' | ' ') => + Stream.junk(strm__) + next_token(strm__) + | Some(('A' .. 'Z' | 'a' .. 'z' | '_' | 'À' .. 'ÿ') as c) => + Stream.junk(strm__) + let s = strm__ + reset_buffer() + store(c) + ident(s) + | Some( + ('!' + | '%' + | '&' + | '$' + | '#' + | '+' + | '/' + | ':' + | '<' + | '=' + | '>' + | '?' + | '@' + | '\\' + | '~' + | '^' + | '|' + | '*') as c, + ) => + Stream.junk(strm__) + let s = strm__ + reset_buffer() + store(c) + ident2(s) + | Some('0' .. '9' as c) => + Stream.junk(strm__) + let s = strm__ + reset_buffer() + store(c) + number(s) + | Some('\'') => + Stream.junk(strm__) + let c = try char(strm__) catch { + | Stream.Failure => raise(Stream.Error("")) + } + + switch Stream.peek(strm__) { + | Some('\'') => + Stream.junk(strm__) + Some(Char(c)) + | _ => raise(Stream.Error("")) + } + | Some('"') => + Stream.junk(strm__) + let s = strm__ + reset_buffer() + Some(String(string(s))) + | Some('-') => + Stream.junk(strm__) + neg_number(strm__) + | Some('(') => + Stream.junk(strm__) + maybe_comment(strm__) + | Some(c) => + Stream.junk(strm__) + Some(keyword_or_error(c)) + | _ => None + } + and ident = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some(('A' .. 'Z' | 'a' .. 'z' | 'À' .. 'ÿ' | '0' .. '9' | '_' | '\'') as c) => + Stream.junk(strm__) + let s = strm__ + store(c) + ident(s) + | _ => Some(ident_or_keyword(get_string())) + } + and ident2 = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some( + ('!' + | '%' + | '&' + | '$' + | '#' + | '+' + | '-' + | '/' + | ':' + | '<' + | '=' + | '>' + | '?' + | '@' + | '\\' + | '~' + | '^' + | '|' + | '*') as c, + ) => + Stream.junk(strm__) + let s = strm__ + store(c) + ident2(s) + | _ => Some(ident_or_keyword(get_string())) + } + and neg_number = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('0' .. '9' as c) => + Stream.junk(strm__) + let s = strm__ + reset_buffer() + store('-') + store(c) + number(s) + | _ => + let s = strm__ + reset_buffer() + store('-') + ident2(s) + } + and number = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('0' .. '9' as c) => + Stream.junk(strm__) + let s = strm__ + store(c) + number(s) + | Some('.') => + Stream.junk(strm__) + let s = strm__ + store('.') + decimal_part(s) + | Some('e' | 'E') => + Stream.junk(strm__) + let s = strm__ + store('E') + exponent_part(s) + | _ => Some(Int(int_of_string(get_string()))) + } + and decimal_part = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('0' .. '9' as c) => + Stream.junk(strm__) + let s = strm__ + store(c) + decimal_part(s) + | Some('e' | 'E') => + Stream.junk(strm__) + let s = strm__ + store('E') + exponent_part(s) + | _ => Some(Float(float_of_string(get_string()))) + } + and exponent_part = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some(('+' | '-') as c) => + Stream.junk(strm__) + let s = strm__ + store(c) + end_exponent_part(s) + | _ => end_exponent_part(strm__) + } + and end_exponent_part = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('0' .. '9' as c) => + Stream.junk(strm__) + let s = strm__ + store(c) + end_exponent_part(s) + | _ => Some(Float(float_of_string(get_string()))) + } + and string = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('"') => + Stream.junk(strm__) + get_string() + | Some('\\') => + Stream.junk(strm__) + let c = try escape(strm__) catch { + | Stream.Failure => raise(Stream.Error("")) + } + + let s = strm__ + store(c) + string(s) + | Some(c) => + Stream.junk(strm__) + let s = strm__ + store(c) + string(s) + | _ => raise(Stream.Failure) + } + and char = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('\\') => + Stream.junk(strm__) + try escape(strm__) catch { + | Stream.Failure => raise(Stream.Error("")) + } + | Some(c) => + Stream.junk(strm__) + c + | _ => raise(Stream.Failure) + } + and escape = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('n') => + Stream.junk(strm__) + '\n' + | Some('r') => + Stream.junk(strm__) + '\r' + | Some('t') => + Stream.junk(strm__) + '\t' + | Some('0' .. '9' as c1) => + Stream.junk(strm__) + switch Stream.peek(strm__) { + | Some('0' .. '9' as c2) => + Stream.junk(strm__) + switch Stream.peek(strm__) { + | Some('0' .. '9' as c3) => + Stream.junk(strm__) + Char.chr((Char.code(c1) - 48) * 100 + (Char.code(c2) - 48) * 10 + (Char.code(c3) - 48)) + | _ => raise(Stream.Error("")) + } + | _ => raise(Stream.Error("")) + } + | Some(c) => + Stream.junk(strm__) + c + | _ => raise(Stream.Failure) + } + and maybe_comment = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('*') => + Stream.junk(strm__) + let s = strm__ + comment(s) + next_token(s) + | _ => Some(keyword_or_error('(')) + } + and comment = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('(') => + Stream.junk(strm__) + maybe_nested_comment(strm__) + | Some('*') => + Stream.junk(strm__) + maybe_end_comment(strm__) + | Some(_) => + Stream.junk(strm__) + comment(strm__) + | _ => raise(Stream.Failure) + } + and maybe_nested_comment = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some('*') => + Stream.junk(strm__) + let s = strm__ + comment(s) + comment(s) + | Some(_) => + Stream.junk(strm__) + comment(strm__) + | _ => raise(Stream.Failure) + } + and maybe_end_comment = (strm__: Stream.t<_>) => + switch Stream.peek(strm__) { + | Some(')') => + Stream.junk(strm__) + () + | Some('*') => + Stream.junk(strm__) + maybe_end_comment(strm__) + | Some(_) => + Stream.junk(strm__) + comment(strm__) + | _ => raise(Stream.Failure) + } + + input => Stream.from(_count => next_token(input)) +} diff --git a/jscomp/stdlib-406/genlex.resi b/jscomp/stdlib-406/genlex.resi new file mode 100644 index 0000000000..14f659b8e9 --- /dev/null +++ b/jscomp/stdlib-406/genlex.resi @@ -0,0 +1,73 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" A generic lexical analyzer. + + + This module implements a simple 'standard' lexical analyzer, presented + as a function from character streams to token streams. It implements + roughly the lexical conventions of OCaml, but is parameterized by the + set of keywords of your language. + + + Example: a lexer suitable for a desk calculator is obtained by + {[ let lexer = make_lexer [\"+\";\"-\";\"*\";\"/\";\"let\";\"=\"; \"(\"; \")\"] ]} + + The associated parser would be a function from [token stream] + to, for instance, [int], and would have rules such as: + + {[ + let rec parse_expr = parser + | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2 + and parse_atom = parser + | [< 'Int n >] -> n + | [< 'Kwd \"(\"; n = parse_expr; 'Kwd \")\" >] -> n + and parse_remainder n1 = parser + | [< 'Kwd \"+\"; n2 = parse_expr >] -> n1+n2 + | [< >] -> n1 + ]} + + One should notice that the use of the [parser] keyword and associated + notation for streams are only available through camlp4 extensions. This + means that one has to preprocess its sources {i e. g.} by using the + [\"-pp\"] command-line switch of the compilers. +") + +@ocaml.doc(" The type of tokens. The lexical classes are: [Int] and [Float] + for integer and floating-point numbers; [String] for + string literals, enclosed in double quotes; [Char] for + character literals, enclosed in single quotes; [Ident] for + identifiers (either sequences of letters, digits, underscores + and quotes, or sequences of 'operator characters' such as + [+], [*], etc); and [Kwd] for keywords (either identifiers or + single 'special characters' such as [(], [}], etc). ") +type token = + | Kwd(string) + | Ident(string) + | Int(int) + | Float(float) + | String(string) + | Char(char) + +@ocaml.doc(" Construct the lexer function. The first argument is the list of + keywords. An identifier [s] is returned as [Kwd s] if [s] + belongs to this list, and as [Ident s] otherwise. + A special character [s] is returned as [Kwd s] if [s] + belongs to this list, and cause a lexical error (exception + {!Stream.Error} with the offending lexeme as its parameter) otherwise. + Blanks and newlines are skipped. Comments delimited by [(*] and [*)] + are skipped as well, and can be nested. A {!Stream.Failure} exception + is raised if end of stream is unexpectedly reached.") +let make_lexer: (list, Stream.t) => Stream.t diff --git a/jscomp/stdlib-406/hashtbl.ml b/jscomp/stdlib-406/hashtbl.ml deleted file mode 100644 index 85f227bfb4..0000000000 --- a/jscomp/stdlib-406/hashtbl.ml +++ /dev/null @@ -1,541 +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 *) - -external seeded_hash_param : - int -> int -> int -> 'a -> int = "?hash" [@@noalloc] -(* 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 ('a, 'b) t = - { mutable size: int; (* number of entries *) - mutable data: ('a, 'b) bucketlist array; (* the buckets *) - mutable seed: int; (* for randomization *) - mutable initial_size: int; (* initial array size *) - } - -and ('a, 'b) bucketlist = - Empty - | Cons of { mutable key: 'a; - mutable data: 'b; - mutable next: ('a, 'b) bucketlist } - -(* 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 - -let prng = lazy (Random.State.make_self_init()) - -(* Creating a fresh, empty table *) - -let rec power_2_above x n = - if x >= n then x - else if x * 2 < x then x (* overflow *) - else power_2_above (x * 2) n - -let create ?(random = !randomized) initial_size = - let s = power_2_above 16 initial_size in - let seed = if random then Random.State.bits (Lazy.force prng) else 0 in - { initial_size = s; size = 0; seed = seed; data = Array.make s Empty } - -let clear h = - h.size <- 0; - let len = Array.length h.data in - for i = 0 to len - 1 do - h.data.(i) <- Empty - done - -let reset h = - let len = Array.length h.data in - if len = abs h.initial_size then - clear h - else begin - h.size <- 0; - h.data <- Array.make (abs h.initial_size) Empty - end - -let copy_bucketlist = function - | Empty -> Empty - | Cons {key; data; next} -> - let rec loop prec = function - | Empty -> () - | Cons {key; data; next} -> - let r = Cons {key; data; next} in - begin match prec with - | Empty -> assert false - | Cons prec -> prec.next <- r - end; - loop r next - in - let r = Cons {key; data; next} in - loop r next; - r - -let copy h = { h with data = Array.map copy_bucketlist h.data } - -let length h = h.size - -let resize indexfun h = - let odata = h.data in - let osize = Array.length odata in - let nsize = osize * 2 in - if - nsize >= osize - then begin - let ndata = Array.make nsize Empty in - let ndata_tail = Array.make nsize Empty in - let inplace = not (ongoing_traversal h) in - h.data <- ndata; (* so that indexfun sees the new bucket count *) - let rec insert_bucket = function - | Empty -> () - | Cons {key; data; next} as cell -> - let cell = - if inplace then cell - else Cons {key; data; next = Empty} - in - let nidx = indexfun h key in - begin match ndata_tail.(nidx) with - | Empty -> ndata.(nidx) <- cell; - | Cons tail -> tail.next <- cell; - end; - ndata_tail.(nidx) <- cell; - insert_bucket next - in - for i = 0 to osize - 1 do - insert_bucket odata.(i) - done; - if inplace then - for i = 0 to nsize - 1 do - match ndata_tail.(i) with - | Empty -> () - | Cons tail -> tail.next <- Empty - done; - end - -let key_index h key = - (* compatibility with old hash tables *) - (seeded_hash_param 10 100 h.seed key) land (Array.length h.data - 1) - - -let add h key data = - let i = key_index h key in - let bucket = Cons{key; data; next=h.data.(i)} in - h.data.(i) <- bucket; - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h - -let rec remove_bucket h i key prec = function - | Empty -> - () - | (Cons {key=k; next}) as c -> - if compare k key = 0 - then begin - h.size <- h.size - 1; - match prec with - | Empty -> h.data.(i) <- next - | Cons c -> c.next <- next - end - else remove_bucket h i key c next - -let remove h key = - let i = key_index h key in - remove_bucket h i key Empty h.data.(i) - -let rec find_rec key = function - | Empty -> - raise Not_found - | Cons{key=k; data; next} -> - if compare key k = 0 then data else find_rec key next - -let find h key = - match h.data.(key_index h key) with - | Empty -> raise Not_found - | Cons{key=k1; data=d1; next=next1} -> - if compare key k1 = 0 then d1 else - match next1 with - | Empty -> raise Not_found - | Cons{key=k2; data=d2; next=next2} -> - if compare key k2 = 0 then d2 else - match next2 with - | Empty -> raise Not_found - | Cons{key=k3; data=d3; next=next3} -> - if compare key k3 = 0 then d3 else find_rec key next3 - -let rec find_rec_opt key = function - | Empty -> - None - | Cons{key=k; data; next} -> - if compare key k = 0 then Some data else find_rec_opt key next - -let find_opt h key = - match h.data.(key_index h key) with - | Empty -> None - | Cons{key=k1; data=d1; next=next1} -> - if compare key k1 = 0 then Some d1 else - match next1 with - | Empty -> None - | Cons{key=k2; data=d2; next=next2} -> - if compare key k2 = 0 then Some d2 else - match next2 with - | Empty -> None - | Cons{key=k3; data=d3; next=next3} -> - if compare key k3 = 0 then Some d3 else find_rec_opt key next3 - -let find_all h key = - let rec find_in_bucket = function - | Empty -> - [] - | Cons{key=k; data; next} -> - if compare k key = 0 - then data :: find_in_bucket next - else find_in_bucket next in - find_in_bucket h.data.(key_index h key) - -let rec replace_bucket key data = function - | Empty -> - true - | Cons ({key=k; next} as slot) -> - if compare k key = 0 - then (slot.key <- key; slot.data <- data; false) - else replace_bucket key data next - -let replace h key data = - let i = key_index h key in - let l = h.data.(i) in - if replace_bucket key data l then begin - h.data.(i) <- Cons{key; data; next=l}; - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h - end - -let mem h key = - let rec mem_in_bucket = function - | Empty -> - false - | Cons{key=k; next} -> - compare k key = 0 || mem_in_bucket next in - mem_in_bucket h.data.(key_index h key) - -let iter f h = - let rec do_bucket = function - | Empty -> - () - | Cons{key; data; next} -> - f key data; do_bucket next in - let old_trav = ongoing_traversal h in - if not old_trav then flip_ongoing_traversal h; - try - let d = h.data in - for i = 0 to Array.length d - 1 do - do_bucket d.(i) - done; - if not old_trav then flip_ongoing_traversal h; - with exn when not old_trav -> - flip_ongoing_traversal h; - raise exn - -let rec filter_map_inplace_bucket f h i prec = function - | Empty -> - begin match prec with - | Empty -> h.data.(i) <- Empty - | Cons c -> c.next <- Empty - end - | (Cons ({key; data; next} as c)) as slot -> - begin match f key data with - | None -> - h.size <- h.size - 1; - filter_map_inplace_bucket f h i prec next - | Some data -> - begin match prec with - | Empty -> h.data.(i) <- slot - | Cons c -> c.next <- slot - end; - c.data <- data; - filter_map_inplace_bucket f h i slot next - end - -let filter_map_inplace f h = - let d = h.data in - let old_trav = ongoing_traversal h in - if not old_trav then flip_ongoing_traversal h; - try - for i = 0 to Array.length d - 1 do - filter_map_inplace_bucket f h i Empty h.data.(i) - done - with exn when not old_trav -> - flip_ongoing_traversal h; - raise exn - -let fold f h init = - let rec do_bucket b accu = - match b with - Empty -> - accu - | Cons{key; data; next} -> - do_bucket next (f key data accu) in - let old_trav = ongoing_traversal h in - if not old_trav then flip_ongoing_traversal h; - try - let d = h.data in - let accu = ref init in - for i = 0 to Array.length d - 1 do - accu := do_bucket d.(i) !accu - done; - if not old_trav then flip_ongoing_traversal h; - !accu - with exn when not old_trav -> - flip_ongoing_traversal h; - raise exn - -type statistics = { - num_bindings: int; - num_buckets: int; - max_bucket_length: int; - bucket_histogram: int array -} - -let rec bucket_length accu = function - | Empty -> accu - | Cons{next} -> bucket_length (accu + 1) next - -let stats h = - let mbl = - Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in - let histo = Array.make (mbl + 1) 0 in - Array.iter - (fun b -> - let l = bucket_length 0 b in - 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 = - sig - type t - val equal: t -> t -> bool - val hash: t -> int - end - -module type SeededHashedType = - sig - type t - val equal: t -> t -> bool - val hash: int -> t -> int - end - -module type S = - sig - type key - type 'a t - val create: int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy: 'a t -> 'a t - val add: 'a t -> key -> 'a -> unit - val remove: 'a t -> key -> unit - val find: 'a t -> key -> 'a - val find_opt: 'a t -> key -> 'a option - val find_all: 'a t -> key -> 'a list - val replace : 'a t -> key -> 'a -> unit - val mem : 'a t -> key -> bool - val iter: (key -> 'a -> unit) -> 'a t -> unit - val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val length: 'a t -> int - val stats: 'a t -> statistics - end - -module type SeededS = - sig - type key - type 'a t - val create : ?random:bool -> int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy : 'a t -> 'a t - val add : 'a t -> key -> 'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt: 'a t -> key -> 'a option - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key -> 'a -> unit - val mem : 'a t -> key -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics - end - -module MakeSeeded(H: SeededHashedType): (SeededS with type key = H.t) = - struct - type key = H.t - type 'a hashtbl = (key, 'a) t - type 'a t = 'a hashtbl - let create = create - let clear = clear - let reset = reset - let copy = copy - - let key_index h key = - (H.hash h.seed key) land (Array.length h.data - 1) - - let add h key data = - let i = key_index h key in - let bucket = Cons{key; data; next=h.data.(i)} in - h.data.(i) <- bucket; - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h - - let rec remove_bucket h i key prec = function - | Empty -> - () - | (Cons {key=k; next}) as c -> - if H.equal k key - then begin - h.size <- h.size - 1; - match prec with - | Empty -> h.data.(i) <- next - | Cons c -> c.next <- next - end - else remove_bucket h i key c next - - let remove h key = - let i = key_index h key in - remove_bucket h i key Empty h.data.(i) - - let rec find_rec key = function - | Empty -> - raise Not_found - | Cons{key=k; data; next} -> - if H.equal key k then data else find_rec key next - - let find h key = - match h.data.(key_index h key) with - | Empty -> raise Not_found - | Cons{key=k1; data=d1; next=next1} -> - if H.equal key k1 then d1 else - match next1 with - | Empty -> raise Not_found - | Cons{key=k2; data=d2; next=next2} -> - if H.equal key k2 then d2 else - match next2 with - | Empty -> raise Not_found - | Cons{key=k3; data=d3; next=next3} -> - if H.equal key k3 then d3 else find_rec key next3 - - let rec find_rec_opt key = function - | Empty -> - None - | Cons{key=k; data; next} -> - if H.equal key k then Some data else find_rec_opt key next - - let find_opt h key = - match h.data.(key_index h key) with - | Empty -> None - | Cons{key=k1; data=d1; next=next1} -> - if H.equal key k1 then Some d1 else - match next1 with - | Empty -> None - | Cons{key=k2; data=d2; next=next2} -> - if H.equal key k2 then Some d2 else - match next2 with - | Empty -> None - | Cons{key=k3; data=d3; next=next3} -> - if H.equal key k3 then Some d3 else find_rec_opt key next3 - - let find_all h key = - let rec find_in_bucket = function - | Empty -> - [] - | Cons{key=k; data=d; next} -> - if H.equal k key - then d :: find_in_bucket next - else find_in_bucket next in - find_in_bucket h.data.(key_index h key) - - let rec replace_bucket key data = function - | Empty -> - true - | Cons ({key=k; next} as slot) -> - if H.equal k key - then (slot.key <- key; slot.data <- data; false) - else replace_bucket key data next - - let replace h key data = - let i = key_index h key in - let l = h.data.(i) in - if replace_bucket key data l then begin - h.data.(i) <- Cons{key; data; next=l}; - h.size <- h.size + 1; - if h.size > Array.length h.data lsl 1 then resize key_index h - end - - let mem h key = - let rec mem_in_bucket = function - | Empty -> - false - | Cons{key=k; next} -> - H.equal k key || mem_in_bucket next in - 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 - end - -module Make(H: HashedType): (S with type key = H.t) = - struct - include MakeSeeded(struct - type t = H.t - let equal = H.equal - let hash (_seed: int) x = H.hash x - end) - let create sz = create ~random:false sz - end diff --git a/jscomp/stdlib-406/hashtbl.res b/jscomp/stdlib-406/hashtbl.res new file mode 100644 index 0000000000..b29afbca2e --- /dev/null +++ b/jscomp/stdlib-406/hashtbl.res @@ -0,0 +1,679 @@ +/* ************************************************************************ */ +/* */ +/* 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 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.mli b/jscomp/stdlib-406/hashtbl.resi similarity index 56% rename from jscomp/stdlib-406/hashtbl.mli rename to jscomp/stdlib-406/hashtbl.resi index 6449c055d8..bcf9c988db 100644 --- a/jscomp/stdlib-406/hashtbl.mli +++ b/jscomp/stdlib-406/hashtbl.resi @@ -1,32 +1,29 @@ -(**************************************************************************) -(* *) -(* 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. +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. -*) +") +@@ocaml.text(" {1 Generic interface} ") -(** {1 Generic interface} *) +@ocaml.doc(" The type of hash tables from type ['a] to type ['b]. ") +type t<'a, 'b> - -type ('a, 'b) t -(** The type of hash tables from type ['a] to type ['b]. *) - -val create : ?random:bool -> int -> ('a, 'b) t -(** [Hashtbl.create n] creates a new, empty hash table, with +@ocaml.doc(" [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 @@ -62,59 +59,59 @@ val create : ?random:bool -> int -> ('a, 'b) t 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. *) + hash tables were created in non-randomized mode. ") +let create: (~random: bool=?, int) => t<'a, 'b> -val clear : ('a, 'b) t -> unit -(** Empty a hash table. Use [reset] instead of [clear] to shrink the - size of the bucket table to its initial size. *) +@ocaml.doc(" 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 -val reset : ('a, 'b) t -> unit -(** Empty a hash table and shrink the size of the bucket table +@ocaml.doc(" Empty a hash table and shrink the size of the bucket table to its initial size. - @since 4.00.0 *) + @since 4.00.0 ") +let reset: t<'a, 'b> => unit -val copy : ('a, 'b) t -> ('a, 'b) t -(** Return a copy of the given hashtable. *) +@ocaml.doc(" Return a copy of the given hashtable. ") +let copy: t<'a, 'b> => t<'a, 'b> -val add : ('a, 'b) t -> 'a -> 'b -> unit -(** [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. +@ocaml.doc(" [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.) *) + (Same behavior as with association lists.) ") +let add: (t<'a, 'b>, 'a, 'b) => unit -val find : ('a, 'b) t -> 'a -> 'b -(** [Hashtbl.find tbl x] returns the current binding of [x] in [tbl], - or raises [Not_found] if no such binding exists. *) +@ocaml.doc(" [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 -val find_opt : ('a, 'b) t -> 'a -> 'b option -(** [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl], +@ocaml.doc(" [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl], or [None] if no such binding exists. - @since 4.05 *) + @since 4.05 ") +let find_opt: (t<'a, 'b>, 'a) => option<'b> -val find_all : ('a, 'b) t -> 'a -> 'b list -(** [Hashtbl.find_all tbl x] returns the list of all data +@ocaml.doc(" [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. *) + bindings, in reverse order of introduction in the table. ") +let find_all: (t<'a, 'b>, 'a) => list<'b> -val mem : ('a, 'b) t -> 'a -> bool -(** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. *) +@ocaml.doc(" [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. ") +let mem: (t<'a, 'b>, 'a) => bool -val remove : ('a, 'b) t -> 'a -> unit -(** [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], +@ocaml.doc(" [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]. *) + It does nothing if [x] is not bound in [tbl]. ") +let remove: (t<'a, 'b>, 'a) => unit -val replace : ('a, 'b) t -> 'a -> 'b -> unit -(** [Hashtbl.replace tbl x y] replaces the current binding of [x] +@ocaml.doc(" [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]. *) + followed by {!Hashtbl.add}[ tbl x y]. ") +let replace: (t<'a, 'b>, 'a, 'b) => unit -val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit -(** [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. +@ocaml.doc(" [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]. @@ -131,20 +128,20 @@ val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit 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 -val filter_map_inplace: ('a -> 'b -> 'b option) -> ('a, 'b) t -> unit -(** [Hashtbl.filter_map_inplace f tbl] applies [f] to all bindings in +@ocaml.doc(" [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 *) + @since 4.03.0 ") +let filter_map_inplace: (('a, 'b) => option<'b>, t<'a, 'b>) => unit -val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c -(** [Hashtbl.fold f tbl init] computes +@ocaml.doc(" [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. @@ -163,16 +160,16 @@ val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c 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 -val length : ('a, 'b) t -> int -(** [Hashtbl.length tbl] returns the number of bindings in [tbl]. +@ocaml.doc(" [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. *) + first argument. ") +let length: t<'a, 'b> => int -val randomize : unit -> unit -(** After a call to [Hashtbl.randomize()], hash tables are created in +@ocaml.doc(" 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 @@ -188,37 +185,38 @@ val randomize : unit -> unit This is intentional. Non-randomized hash tables can still be created using [Hashtbl.create ~random:false]. - @since 4.00.0 *) + @since 4.00.0 ") +let randomize: unit => unit -val is_randomized : unit -> bool -(** return if the tables are currently created in randomized mode by default +@ocaml.doc(" return if the tables are currently created in randomized mode by default - @since 4.03.0 *) + @since 4.03.0 ") +let is_randomized: unit => bool -(** @since 4.00.0 *) +@ocaml.doc(" @since 4.00.0 ") type statistics = { - num_bindings: int; - (** Number of bindings present in the table. - Same value as returned by {!Hashtbl.length}. *) - num_buckets: int; - (** Number of buckets in the table. *) - max_bucket_length: int; - (** Maximal number of bindings per bucket. *) - bucket_histogram: int array - (** Histogram of bucket sizes. This array [histo] has + @ocaml.doc(" Number of bindings present in the table. + Same value as returned by {!Hashtbl.length}. ") + num_bindings: int, + @ocaml.doc(" Number of buckets in the table. ") + num_buckets: int, + @ocaml.doc(" Maximal number of bindings per bucket. ") + max_bucket_length: int, + @ocaml.doc(" 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]. *) + [histo.(i)] is the number of buckets whose size is [i]. ") + bucket_histogram: array, } -val stats : ('a, 'b) t -> statistics -(** [Hashtbl.stats tbl] returns statistics about the table [tbl]: +@ocaml.doc(" [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 *) + @since 4.00.0 ") +let stats: t<'a, 'b> => statistics -(** {1 Functorial interface} *) +@@ocaml.text(" {1 Functorial interface} ") -(** The functorial interface allows the use of specific comparison +@@ocaml.text(" 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. @@ -234,7 +232,7 @@ val stats : ('a, 'b) t -> statistics module IntHashtbl = Hashtbl.Make(IntHash) let h = IntHashtbl.create 17 in - IntHashtbl.add h 12 "hello" + IntHashtbl.add h 12 \"hello\" ]} This creates a new module [IntHashtbl], with a new type ['a @@ -245,18 +243,17 @@ val stats : ('a, 'b) t -> statistics the type [('a,'b) Hashtbl.t] of the generic interface. For example, [Hashtbl.length h] would not type-check, you must use [IntHashtbl.length]. -*) +") -module type HashedType = - sig - type t - (** The type of the hashtable keys. *) +@ocaml.doc(" The input signature of the functor {!Hashtbl.Make}. ") +module type HashedType = { + @ocaml.doc(" The type of the hashtable keys. ") + type t - val equal : t -> t -> bool - (** The equality predicate used to compare keys. *) + @ocaml.doc(" The equality predicate used to compare keys. ") + let equal: (t, t) => bool - val hash : t -> int - (** A hashing function on keys. It must be such that if two keys are + @ocaml.doc(" 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 @@ -267,40 +264,40 @@ module type HashedType = 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). *) - end -(** The input signature of the functor {!Hashtbl.Make}. *) - -module type S = - sig - type key - type 'a t - val create : int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit (** @since 4.00.0 *) - - val copy : 'a t -> 'a t - val add : 'a t -> key -> 'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt : 'a t -> key -> 'a option - (** @since 4.05.0 *) - - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key -> 'a -> unit - val mem : 'a t -> key -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit - (** @since 4.03.0 *) - - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics (** @since 4.00.0 *) - end -(** The output signature of the functor {!Hashtbl.Make}. *) - -module Make (H : HashedType) : S with type key = H.t -(** Functor building an implementation of the hashtable structure. + equality (e.g. for mutable or cyclic objects). ") + let hash: t => int +} + +@ocaml.doc(" 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 + @ocaml.doc(" @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 + @ocaml.doc(" @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 + @ocaml.doc(" @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 + @ocaml.doc(" @since 4.00.0 ") + let stats: t<'a> => statistics +} + +@ocaml.doc(" 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]. @@ -309,55 +306,54 @@ module Make (H : HashedType) : S with type key = H.t 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. *) + non-randomized hash tables. ") +module Make: (H: HashedType) => (S with type key = H.t) -module type SeededHashedType = - sig - type t - (** The type of the hashtable keys. *) +@ocaml.doc(" The input signature of the functor {!Hashtbl.MakeSeeded}. + @since 4.00.0 ") +module type SeededHashedType = { + @ocaml.doc(" The type of the hashtable keys. ") + type t - val equal: t -> t -> bool - (** The equality predicate used to compare keys. *) + @ocaml.doc(" The equality predicate used to compare keys. ") + let equal: (t, t) => bool - val hash: int -> t -> int - (** A seeded hashing function on keys. The first argument is + @ocaml.doc(" 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. *) - end -(** The input signature of the functor {!Hashtbl.MakeSeeded}. - @since 4.00.0 *) - -module type SeededS = - sig - type key - type 'a t - val create : ?random:bool -> int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy : 'a t -> 'a t - val add : 'a t -> key -> 'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt : 'a t -> key -> 'a option (** @since 4.05.0 *) - - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key -> 'a -> unit - val mem : 'a t -> key -> bool - val iter : (key -> 'a -> unit) -> 'a t -> unit - val filter_map_inplace: (key -> 'a -> 'a option) -> 'a t -> unit - (** @since 4.03.0 *) - - val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics - end -(** The output signature of the functor {!Hashtbl.MakeSeeded}. - @since 4.00.0 *) - -module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t -(** Functor building an implementation of the hashtable structure. + below. ") + let hash: (int, t) => int +} + +@ocaml.doc(" 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 + @ocaml.doc(" @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 + @ocaml.doc(" @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 +} + +@ocaml.doc(" 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]. @@ -368,25 +364,23 @@ module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t 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 *) - - -(** {1 The polymorphic hash functions} *) + @since 4.00.0 ") +module MakeSeeded: (H: SeededHashedType) => (SeededS with type key = H.t) +@@ocaml.text(" {1 The polymorphic hash functions} ") -val hash : 'a -> int -(** [Hashtbl.hash x] associates a nonnegative integer to any value of +@ocaml.doc(" [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. *) + Moreover, [hash] always terminates, even on cyclic structures. ") +let hash: 'a => int -val seeded_hash : int -> 'a -> int -(** A variant of {!Hashtbl.hash} that is further parameterized by +@ocaml.doc(" A variant of {!Hashtbl.hash} that is further parameterized by an integer seed. - @since 4.00.0 *) + @since 4.00.0 ") +let seeded_hash: (int, 'a) => int -val hash_param : int -> int -> 'a -> int -(** [Hashtbl.hash_param meaningful total x] computes a hash value for [x], +@ocaml.doc(" [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 @@ -402,10 +396,11 @@ val hash_param : int -> int -> 'a -> int 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]. *) + [meaningful = 10] and [total = 100]. ") +let hash_param: (int, int, 'a) => int -val seeded_hash_param : int -> int -> int -> 'a -> int -(** A variant of {!Hashtbl.hash_param} that is further parameterized by +@ocaml.doc(" 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 *) + @since 4.00.0 ") +let seeded_hash_param: (int, int, int, 'a) => int diff --git a/jscomp/stdlib-406/hashtblLabels.ml b/jscomp/stdlib-406/hashtblLabels.ml deleted file mode 100644 index de56d08a8d..0000000000 --- a/jscomp/stdlib-406/hashtblLabels.ml +++ /dev/null @@ -1,130 +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 ('a, 'b) t = ('a,'b) Hashtbl.t - - - -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 (fun key data -> f ~key ~data) tbl - -let filter_map_inplace ~f tbl = - filter_map_inplace (fun key data -> f ~key ~data) tbl - -let fold ~f tbl ~init = - fold (fun 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: int array -} - - -(* Functorial interface *) - -module type HashedType = Hashtbl.HashedType - -module type SeededHashedType = Hashtbl.SeededHashedType - - -module type S = -sig - type key - and 'a t - val create : int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy : 'a t -> 'a t - val add : 'a t -> key:key -> data:'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt: 'a t -> key -> 'a option - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key:key -> data:'a -> unit - val mem : 'a t -> key -> bool - val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit - val filter_map_inplace: - f:(key:key -> data:'a -> 'a option) -> 'a t -> unit - val fold : - f:(key:key -> data:'a -> 'b -> 'b) -> - 'a t -> init:'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics -end - -module type SeededS = -sig - type key - and 'a t - val create : ?random:bool -> int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy : 'a t -> 'a t - val add : 'a t -> key:key -> data:'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt : 'a t -> key -> 'a option - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key:key -> data:'a -> unit - val mem : 'a t -> key -> bool - val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit - val filter_map_inplace: - f:(key:key -> data:'a -> 'a option) -> 'a t -> unit - val fold : - f:(key:key -> data:'a -> 'b -> 'b) -> - 'a t -> init:'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics -end - -module MakeSeeded(H: SeededHashedType): (SeededS with type key = H.t) = struct - 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 (fun key data -> f ~key ~data) tbl - - - - - - let filter_map_inplace ~f tbl = - filter_map_inplace (fun key data -> f ~key ~data) tbl - - let fold ~f tbl ~init = - fold (fun key data acc -> f ~key ~data acc) tbl init - -end - -module Make(H: HashedType): (S with type key = H.t) = - struct - include MakeSeeded(struct - type t = H.t - let equal = H.equal - let hash (_seed: int) x = H.hash x - end) - let create sz = create ~random:false sz - end diff --git a/jscomp/stdlib-406/hashtblLabels.res b/jscomp/stdlib-406/hashtblLabels.res new file mode 100644 index 0000000000..e9fe63a1fa --- /dev/null +++ b/jscomp/stdlib-406/hashtblLabels.res @@ -0,0 +1,129 @@ +/* ************************************************************************ */ +/* */ +/* 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/int32.ml b/jscomp/stdlib-406/int32.ml deleted file mode 100644 index 830e40df71..0000000000 --- a/jscomp/stdlib-406/int32.ml +++ /dev/null @@ -1,64 +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. *) -(* *) -(**************************************************************************) -type t = int -(* Module [t]: 32-bit integers *) - -external neg : t -> t = "%negint" -external add : t -> t -> t = "%addint" -external sub : t -> t -> t = "%subint" -external mul : t -> t -> t = "%mulint" -external div : t -> t -> t = "%divint" -external rem : t -> t -> t = "%modint" -external logand : t -> t -> t = "%andint" -external logor : t -> t -> t = "%orint" -external logxor : t -> t -> t = "%xorint" -external shift_left : t -> int -> t = "%lslint" -external shift_right : t -> int -> t = "%asrint" -external shift_right_logical : t -> int -> t = "%lsrint" -external of_int : int -> t = "%identity" -external to_int : t -> int = "%identity" -external of_float : float -> t - = "?int_of_float" -external to_float : t -> float - = "?int_to_float" -external bits_of_float : float -> t - = "?int_bits_of_float" -external float_of_bits : t -> float - = "?int_float_of_bits" - -let zero = 0l -let one = 1l -let minus_one = -1l -let succ n = add n 1l -let pred n = sub n 1l -let abs n = if n >= 0l then n else neg n -let min_int = 0x80000000l -let max_int = 0x7FFFFFFFl -let lognot n = logxor n (-1l) - -external format : string -> t -> string = "?format_int" -let to_string n = format "%d" n - -external of_string : string -> t = "?int_of_string" - -let of_string_opt s = - (* TODO: expose a non-raising primitive directly. *) - try Some (of_string s) - with Failure _ -> None - - - -let compare (x: t) (y: t) = Pervasives.compare x y -let equal (x: t) (y: t) = compare x y = 0 diff --git a/jscomp/stdlib-406/int32.mli b/jscomp/stdlib-406/int32.mli deleted file mode 100644 index dbf7a01a2b..0000000000 --- a/jscomp/stdlib-406/int32.mli +++ /dev/null @@ -1,186 +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. *) -(* *) -(**************************************************************************) - -(** 32-bit integers. - - This module provides operations on the type [t] - of signed 32-bit integers. Unlike the built-in [int] type, - the type [t] is guaranteed to be exactly 32-bit wide on all - platforms. All arithmetic operations over [t] are taken - modulo 2{^32}. - - Performance notice: values of type [t] occupy more memory - space than values of type [int], and arithmetic operations on - [t] are generally slower than those on [int]. Use [t] - only when the application requires exact 32-bit arithmetic. *) -type t = int -(** An alias for the type of 32-bit integers. *) - -val zero : t -(** The 32-bit integer 0. *) - -val one : t -(** The 32-bit integer 1. *) - -val minus_one : t -(** The 32-bit integer -1. *) - -external neg : t -> t = "%negint" -(** Unary negation. *) - -external add : t -> t -> t = "%addint" -(** Addition. *) - -external sub : t -> t -> t = "%subint" -(** Subtraction. *) - -external mul : t -> t -> t = "%mulint" -(** Multiplication. *) - -external div : t -> t -> t = "%divint" -(** Integer division. Raise [Division_by_zero] if the second - argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. *) - -external rem : t -> t -> t = "%modint" -(** Integer remainder. If [y] is not zero, the result - of [Int32.rem x y] satisfies the following property: - [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)]. - If [y = 0], [Int32.rem x y] raises [Division_by_zero]. *) - -val succ : t -> t -(** Successor. [Int32.succ x] is [Int32.add x Int32.one]. *) - -val pred : t -> t -(** Predecessor. [Int32.pred x] is [Int32.sub x Int32.one]. *) - -val abs : t -> t -(** Return the absolute value of its argument. *) - -val max_int : t -(** The greatest representable 32-bit integer, 2{^31} - 1. *) - -val min_int : t -(** The smallest representable 32-bit integer, -2{^31}. *) - - -external logand : t -> t -> t = "%andint" -(** Bitwise logical and. *) - -external logor : t -> t -> t = "%orint" -(** Bitwise logical or. *) - -external logxor : t -> t -> t = "%xorint" -(** Bitwise logical exclusive or. *) - -val lognot : t -> t -(** Bitwise logical negation. *) - -external shift_left : t -> int -> t = "%lslint" -(** [Int32.shift_left x y] shifts [x] to the left by [y] bits. - The result is unspecified if [y < 0] or [y >= 32]. *) - -external shift_right : t -> int -> t = "%asrint" -(** [Int32.shift_right x y] shifts [x] to the right by [y] bits. - This is an arithmetic shift: the sign bit of [x] is replicated - and inserted in the vacated bits. - The result is unspecified if [y < 0] or [y >= 32]. *) - -external shift_right_logical : t -> int -> t = "%lsrint" -(** [Int32.shift_right_logical x y] shifts [x] to the right by [y] bits. - This is a logical shift: zeroes are inserted in the vacated bits - regardless of the sign of [x]. - The result is unspecified if [y < 0] or [y >= 32]. *) - -external of_int : int -> t = "%identity" -(** Convert the given integer (type [int]) to a 32-bit integer - (type [t]). *) - -external to_int : t -> int = "%identity" -(** Convert the given 32-bit integer (type [t]) to an - integer (type [int]). On 32-bit platforms, the 32-bit integer - is taken modulo 2{^31}, i.e. the high-order bit is lost - during the conversion. On 64-bit platforms, the conversion - is exact. *) - -external of_float : float -> t - = "?int_of_float" -(** Convert the given floating-point number to a 32-bit integer, - discarding the fractional part (truncate towards 0). - The result of the conversion is undefined if, after truncation, - the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. *) - -external to_float : t -> float - = "?int_to_float" -(** Convert the given 32-bit integer to a floating-point number. *) - -external of_string : string -> t = "?int_of_string" -(** Convert the given string to a 32-bit integer. - The string is read in decimal (by default, or if the string - begins with [0u]) or in hexadecimal, octal or binary if the - string begins with [0x], [0o] or [0b] respectively. - - The [0u] prefix reads the input as an unsigned integer in the range - [[0, 2*Int32.max_int+1]]. If the input exceeds {!Int32.max_int} - it is converted to the signed integer - [Int32.min_int + input - Int32.max_int - 1]. - - The [_] (underscore) character can appear anywhere in the string - and is ignored. - Raise [Failure "Int32.of_string"] if the given string is not - a valid representation of an integer, or if the integer represented - exceeds the range of integers representable in type [t]. *) - -val of_string_opt: string -> t option -(** Same as [of_string], but return [None] instead of raising. - @since 4.05 *) - - -val to_string : t -> string -(** Return the string representation of its argument, in signed decimal. *) - -external bits_of_float : float -> t - = "?int_bits_of_float" -(** Return the internal representation of the given float according - to the IEEE 754 floating-point 'single format' bit layout. - Bit 31 of the result represents the sign of the float; - bits 30 to 23 represent the (biased) exponent; bits 22 to 0 - represent the mantissa. *) - -external float_of_bits : t -> float - = "?int_float_of_bits" -(** Return the floating-point number whose internal representation, - according to the IEEE 754 floating-point 'single format' bit layout, - is the given [t]. *) - - - -val compare: t -> t -> int -(** The comparison function for 32-bit integers, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] - allows the module [Int32] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) - -val equal: t -> t -> bool -(** The equal function for int32s. - @since 4.03.0 *) - -(**/**) - -(** {1 Deprecated functions} *) - -external format : string -> t -> string = "?format_int" -(** Do not use this deprecated function. Instead, - used {!Printf.sprintf} with a [%l...] format. *) diff --git a/jscomp/stdlib-406/int32.res b/jscomp/stdlib-406/int32.res new file mode 100644 index 0000000000..d3a53dbbdf --- /dev/null +++ b/jscomp/stdlib-406/int32.res @@ -0,0 +1,64 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ +type t = int +/* Module [t]: 32-bit integers */ + +external neg: t => t = "%negint" +external add: (t, t) => t = "%addint" +external sub: (t, t) => t = "%subint" +external mul: (t, t) => t = "%mulint" +external div: (t, t) => t = "%divint" +external rem: (t, t) => t = "%modint" +external logand: (t, t) => t = "%andint" +external logor: (t, t) => t = "%orint" +external logxor: (t, t) => t = "%xorint" +external shift_left: (t, int) => t = "%lslint" +external shift_right: (t, int) => t = "%asrint" +external shift_right_logical: (t, int) => t = "%lsrint" +external of_int: int => t = "%identity" +external to_int: t => int = "%identity" +external of_float: float => t = "?int_of_float" +external to_float: t => float = "?int_to_float" +external bits_of_float: float => t = "?int_bits_of_float" +external float_of_bits: t => float = "?int_float_of_bits" + +let zero = 0l +let one = 1l +let minus_one = -1l +let succ = n => add(n, 1l) +let pred = n => sub(n, 1l) +let abs = n => + if n >= 0l { + n + } else { + neg(n) + } +let min_int = 0x80000000l +let max_int = 0x7FFFFFFFl +let lognot = n => logxor(n, -1l) + +external format: (string, t) => string = "?format_int" +let to_string = n => format("%d", n) + +external of_string: string => t = "?int_of_string" + +let of_string_opt = s => + /* TODO: expose a non-raising primitive directly. */ + try Some(of_string(s)) catch { + | Failure(_) => None + } + +let compare = (x: t, y: t) => Pervasives.compare(x, y) +let equal = (x: t, y: t) => compare(x, y) == 0 diff --git a/jscomp/stdlib-406/int32.resi b/jscomp/stdlib-406/int32.resi new file mode 100644 index 0000000000..784c8bb8a4 --- /dev/null +++ b/jscomp/stdlib-406/int32.resi @@ -0,0 +1,178 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +@ocaml.doc(" 32-bit integers. + + This module provides operations on the type [t] + of signed 32-bit integers. Unlike the built-in [int] type, + the type [t] is guaranteed to be exactly 32-bit wide on all + platforms. All arithmetic operations over [t] are taken + modulo 2{^32}. + + Performance notice: values of type [t] occupy more memory + space than values of type [int], and arithmetic operations on + [t] are generally slower than those on [int]. Use [t] + only when the application requires exact 32-bit arithmetic. ") +@ocaml.doc(" An alias for the type of 32-bit integers. ") +type t = int + +@ocaml.doc(" The 32-bit integer 0. ") +let zero: t + +@ocaml.doc(" The 32-bit integer 1. ") +let one: t + +@ocaml.doc(" The 32-bit integer -1. ") +let minus_one: t + +@ocaml.doc(" Unary negation. ") +external neg: t => t = "%negint" + +@ocaml.doc(" Addition. ") +external add: (t, t) => t = "%addint" + +@ocaml.doc(" Subtraction. ") +external sub: (t, t) => t = "%subint" + +@ocaml.doc(" Multiplication. ") +external mul: (t, t) => t = "%mulint" + +@ocaml.doc(" Integer division. Raise [Division_by_zero] if the second + argument is zero. This division rounds the real quotient of + its arguments towards zero, as specified for {!Pervasives.(/)}. ") +external div: (t, t) => t = "%divint" + +@ocaml.doc(" Integer remainder. If [y] is not zero, the result + of [Int32.rem x y] satisfies the following property: + [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)]. + If [y = 0], [Int32.rem x y] raises [Division_by_zero]. ") +external rem: (t, t) => t = "%modint" + +@ocaml.doc(" Successor. [Int32.succ x] is [Int32.add x Int32.one]. ") +let succ: t => t + +@ocaml.doc(" Predecessor. [Int32.pred x] is [Int32.sub x Int32.one]. ") +let pred: t => t + +@ocaml.doc(" Return the absolute value of its argument. ") +let abs: t => t + +@ocaml.doc(" The greatest representable 32-bit integer, 2{^31} - 1. ") +let max_int: t + +@ocaml.doc(" The smallest representable 32-bit integer, -2{^31}. ") +let min_int: t + +@ocaml.doc(" Bitwise logical and. ") +external logand: (t, t) => t = "%andint" + +@ocaml.doc(" Bitwise logical or. ") +external logor: (t, t) => t = "%orint" + +@ocaml.doc(" Bitwise logical exclusive or. ") +external logxor: (t, t) => t = "%xorint" + +@ocaml.doc(" Bitwise logical negation. ") +let lognot: t => t + +@ocaml.doc(" [Int32.shift_left x y] shifts [x] to the left by [y] bits. + The result is unspecified if [y < 0] or [y >= 32]. ") +external shift_left: (t, int) => t = "%lslint" + +@ocaml.doc(" [Int32.shift_right x y] shifts [x] to the right by [y] bits. + This is an arithmetic shift: the sign bit of [x] is replicated + and inserted in the vacated bits. + The result is unspecified if [y < 0] or [y >= 32]. ") +external shift_right: (t, int) => t = "%asrint" + +@ocaml.doc(" [Int32.shift_right_logical x y] shifts [x] to the right by [y] bits. + This is a logical shift: zeroes are inserted in the vacated bits + regardless of the sign of [x]. + The result is unspecified if [y < 0] or [y >= 32]. ") +external shift_right_logical: (t, int) => t = "%lsrint" + +@ocaml.doc(" Convert the given integer (type [int]) to a 32-bit integer + (type [t]). ") +external of_int: int => t = "%identity" + +@ocaml.doc(" Convert the given 32-bit integer (type [t]) to an + integer (type [int]). On 32-bit platforms, the 32-bit integer + is taken modulo 2{^31}, i.e. the high-order bit is lost + during the conversion. On 64-bit platforms, the conversion + is exact. ") +external to_int: t => int = "%identity" + +@ocaml.doc(" Convert the given floating-point number to a 32-bit integer, + discarding the fractional part (truncate towards 0). + The result of the conversion is undefined if, after truncation, + the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. ") +external of_float: float => t = "?int_of_float" + +@ocaml.doc(" Convert the given 32-bit integer to a floating-point number. ") +external to_float: t => float = "?int_to_float" + +@ocaml.doc(" Convert the given string to a 32-bit integer. + The string is read in decimal (by default, or if the string + begins with [0u]) or in hexadecimal, octal or binary if the + string begins with [0x], [0o] or [0b] respectively. + + The [0u] prefix reads the input as an unsigned integer in the range + [[0, 2*Int32.max_int+1]]. If the input exceeds {!Int32.max_int} + it is converted to the signed integer + [Int32.min_int + input - Int32.max_int - 1]. + + The [_] (underscore) character can appear anywhere in the string + and is ignored. + Raise [Failure \"Int32.of_string\"] if the given string is not + a valid representation of an integer, or if the integer represented + exceeds the range of integers representable in type [t]. ") +external of_string: string => t = "?int_of_string" + +@ocaml.doc(" Same as [of_string], but return [None] instead of raising. + @since 4.05 ") +let of_string_opt: string => option + +@ocaml.doc(" Return the string representation of its argument, in signed decimal. ") +let to_string: t => string + +@ocaml.doc(" Return the internal representation of the given float according + to the IEEE 754 floating-point 'single format' bit layout. + Bit 31 of the result represents the sign of the float; + bits 30 to 23 represent the (biased) exponent; bits 22 to 0 + represent the mantissa. ") +external bits_of_float: float => t = "?int_bits_of_float" + +@ocaml.doc(" Return the floating-point number whose internal representation, + according to the IEEE 754 floating-point 'single format' bit layout, + is the given [t]. ") +external float_of_bits: t => float = "?int_float_of_bits" + +@ocaml.doc(" The comparison function for 32-bit integers, with the same specification as + {!Pervasives.compare}. Along with the type [t], this function [compare] + allows the module [Int32] to be passed as argument to the functors + {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int + +@ocaml.doc(" The equal function for int32s. + @since 4.03.0 ") +let equal: (t, t) => bool + +@@ocaml.text("/*") + +@@ocaml.text(" {1 Deprecated functions} ") + +@ocaml.doc(" Do not use this deprecated function. Instead, + used {!Printf.sprintf} with a [%l...] format. ") +external format: (string, t) => string = "?format_int" diff --git a/jscomp/stdlib-406/int64.ml b/jscomp/stdlib-406/int64.ml deleted file mode 100644 index 671d2e2e46..0000000000 --- a/jscomp/stdlib-406/int64.ml +++ /dev/null @@ -1,72 +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. *) -(* *) -(**************************************************************************) - -(* Module [Int64]: 64-bit integers *) - -external neg : int64 -> int64 = "%int64_neg" -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 rem : int64 -> int64 -> int64 = "%int64_mod" -external logand : int64 -> int64 -> int64 = "%int64_and" -external logor : int64 -> int64 -> int64 = "%int64_or" -external logxor : int64 -> int64 -> int64 = "%int64_xor" -external shift_left : int64 -> int -> int64 = "%int64_lsl" -external shift_right : int64 -> int -> int64 = "%int64_asr" -external shift_right_logical : int64 -> int -> int64 = "%int64_lsr" -external of_int : int -> int64 = "%int64_of_int" -external to_int : int64 -> int = "%int64_to_int" -external of_float : float -> int64 - = "?int64_of_float" -external to_float : int64 -> float - = "?int64_to_float" -external of_int32 : int -> int64 = "%int64_of_int32" -external to_int32 : int64 -> int = "%int64_to_int32" - -let zero = 0L -let one = 1L -let minus_one = -1L -(* let succ n = add n 1L *) -external succ : int64 -> int64 = "?int64_succ" -let pred n = sub n 1L -let abs n = if n >= 0L then n else neg n -let min_int = 0x8000000000000000L -let max_int = 0x7FFFFFFFFFFFFFFFL -let lognot n = logxor n (-1L) - -external format : string -> int64 -> string = "?int64_format" -external to_string : int64 -> string = "?int64_to_string" - -external of_string : string -> int64 = "?int64_of_string" - -let of_string_opt s = - (* TODO: expose a non-raising primitive directly. *) - try Some (of_string s) - with Failure _ -> None - - - -external bits_of_float : float -> int64 - = "?int64_bits_of_float" - -external float_of_bits : int64 -> float - = "?int64_float_of_bits" - - -type t = int64 - -let compare (x: t) (y: t) = Pervasives.compare x y -let equal (x: t) (y: t) = compare x y = 0 diff --git a/jscomp/stdlib-406/int64.mli b/jscomp/stdlib-406/int64.mli deleted file mode 100644 index 1f7447db14..0000000000 --- a/jscomp/stdlib-406/int64.mli +++ /dev/null @@ -1,197 +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. *) -(* *) -(**************************************************************************) - -(** 64-bit integers. - - This module provides operations on the type [int64] of - signed 64-bit integers. Unlike the built-in [int] type, - the type [int64] is guaranteed to be exactly 64-bit wide on all - platforms. All arithmetic operations over [int64] are taken - modulo 2{^64} - - Performance notice: values of type [int64] occupy more memory - space than values of type [int], and arithmetic operations on - [int64] are generally slower than those on [int]. Use [int64] - only when the application requires exact 64-bit arithmetic. -*) - -val zero : int64 -(** The 64-bit integer 0. *) - -val one : int64 -(** The 64-bit integer 1. *) - -val minus_one : int64 -(** The 64-bit integer -1. *) - -external neg : int64 -> int64 = "%int64_neg" -(** Unary negation. *) - -external add : int64 -> int64 -> int64 = "%int64_add" -(** Addition. *) - -external sub : int64 -> int64 -> int64 = "%int64_sub" -(** Subtraction. *) - -external mul : int64 -> int64 -> int64 = "%int64_mul" -(** Multiplication. *) - -external div : int64 -> int64 -> int64 = "%int64_div" -(** Integer division. Raise [Division_by_zero] if the second - argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. *) - -external rem : int64 -> int64 -> int64 = "%int64_mod" -(** Integer remainder. If [y] is not zero, the result - of [Int64.rem x y] satisfies the following property: - [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)]. - If [y = 0], [Int64.rem x y] raises [Division_by_zero]. *) - -val succ : int64 -> int64 -(** Successor. [Int64.succ x] is [Int64.add x Int64.one]. *) - -val pred : int64 -> int64 -(** Predecessor. [Int64.pred x] is [Int64.sub x Int64.one]. *) - -val abs : int64 -> int64 -(** Return the absolute value of its argument. *) - -val max_int : int64 -(** The greatest representable 64-bit integer, 2{^63} - 1. *) - -val min_int : int64 -(** The smallest representable 64-bit integer, -2{^63}. *) - -external logand : int64 -> int64 -> int64 = "%int64_and" -(** Bitwise logical and. *) - -external logor : int64 -> int64 -> int64 = "%int64_or" -(** Bitwise logical or. *) - -external logxor : int64 -> int64 -> int64 = "%int64_xor" -(** Bitwise logical exclusive or. *) - -val lognot : int64 -> int64 -(** Bitwise logical negation. *) - -external shift_left : int64 -> int -> int64 = "%int64_lsl" -(** [Int64.shift_left x y] shifts [x] to the left by [y] bits. - The result is unspecified if [y < 0] or [y >= 64]. *) - -external shift_right : int64 -> int -> int64 = "%int64_asr" -(** [Int64.shift_right x y] shifts [x] to the right by [y] bits. - This is an arithmetic shift: the sign bit of [x] is replicated - and inserted in the vacated bits. - The result is unspecified if [y < 0] or [y >= 64]. *) - -external shift_right_logical : int64 -> int -> int64 = "%int64_lsr" -(** [Int64.shift_right_logical x y] shifts [x] to the right by [y] bits. - This is a logical shift: zeroes are inserted in the vacated bits - regardless of the sign of [x]. - The result is unspecified if [y < 0] or [y >= 64]. *) - -external of_int : int -> int64 = "%int64_of_int" -(** Convert the given integer (type [int]) to a 64-bit integer - (type [int64]). *) - -external to_int : int64 -> int = "%int64_to_int" -(** Convert the given 64-bit integer (type [int64]) to an - integer (type [int]). On 64-bit platforms, the 64-bit integer - is taken modulo 2{^63}, i.e. the high-order bit is lost - during the conversion. On 32-bit platforms, the 64-bit integer - is taken modulo 2{^31}, i.e. the top 33 bits are lost - during the conversion. *) - -external of_float : float -> int64 - = "?int64_of_float" -(** Convert the given floating-point number to a 64-bit integer, - discarding the fractional part (truncate towards 0). - The result of the conversion is undefined if, after truncation, - the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. *) - -external to_float : int64 -> float - = "?int64_to_float" -(** Convert the given 64-bit integer to a floating-point number. *) - - -external of_int32 : int -> int64 = "%int64_of_int32" -(** Convert the given 32-bit integer (type [int]) - to a 64-bit integer (type [int64]). *) - -external to_int32 : int64 -> int = "%int64_to_int32" -(** Convert the given 64-bit integer (type [int64]) to a - 32-bit integer (type [int]). The 64-bit integer - is taken modulo 2{^32}, i.e. the top 32 bits are lost - during the conversion. *) - - -external of_string : string -> int64 = "?int64_of_string" -(** Convert the given string to a 64-bit integer. - The string is read in decimal (by default, or if the string - begins with [0u]) or in hexadecimal, octal or binary if the - string begins with [0x], [0o] or [0b] respectively. - - The [0u] prefix reads the input as an unsigned integer in the range - [[0, 2*Int64.max_int+1]]. If the input exceeds {!Int64.max_int} - it is converted to the signed integer - [Int64.min_int + input - Int64.max_int - 1]. - - The [_] (underscore) character can appear anywhere in the string - and is ignored. - Raise [Failure "Int64.of_string"] if the given string is not - a valid representation of an integer, or if the integer represented - exceeds the range of integers representable in type [int64]. *) - -val of_string_opt: string -> int64 option -(** Same as [of_string], but return [None] instead of raising. - @since 4.05 *) - -val to_string : int64 -> string -(** Return the string representation of its argument, in decimal. *) - -external bits_of_float : float -> int64 - = "?int64_bits_of_float" -(** Return the internal representation of the given float according - to the IEEE 754 floating-point 'double format' bit layout. - Bit 63 of the result represents the sign of the float; - bits 62 to 52 represent the (biased) exponent; bits 51 to 0 - represent the mantissa. *) - -external float_of_bits : int64 -> float - = "?int64_float_of_bits" -(** Return the floating-point number whose internal representation, - according to the IEEE 754 floating-point 'double format' bit layout, - is the given [int64]. *) - -type t = int64 -(** An alias for the type of 64-bit integers. *) - -val compare: t -> t -> int -(** The comparison function for 64-bit integers, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] - allows the module [Int64] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) - -val equal: t -> t -> bool -(** The equal function for int64s. - @since 4.03.0 *) - -(**/**) - -(** {1 Deprecated functions} *) - -external format : string -> int64 -> string = "?int64_format" -(** Do not use this deprecated function. Instead, - used {!Printf.sprintf} with a [%L...] format. *) diff --git a/jscomp/stdlib-406/int64.res b/jscomp/stdlib-406/int64.res new file mode 100644 index 0000000000..032a1c4aa4 --- /dev/null +++ b/jscomp/stdlib-406/int64.res @@ -0,0 +1,71 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Module [Int64]: 64-bit integers */ + +external neg: int64 => int64 = "%int64_neg" +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 rem: (int64, int64) => int64 = "%int64_mod" +external logand: (int64, int64) => int64 = "%int64_and" +external logor: (int64, int64) => int64 = "%int64_or" +external logxor: (int64, int64) => int64 = "%int64_xor" +external shift_left: (int64, int) => int64 = "%int64_lsl" +external shift_right: (int64, int) => int64 = "%int64_asr" +external shift_right_logical: (int64, int) => int64 = "%int64_lsr" +external of_int: int => int64 = "%int64_of_int" +external to_int: int64 => int = "%int64_to_int" +external of_float: float => int64 = "?int64_of_float" +external to_float: int64 => float = "?int64_to_float" +external of_int32: int => int64 = "%int64_of_int32" +external to_int32: int64 => int = "%int64_to_int32" + +let zero = 0L +let one = 1L +let minus_one = -1L +/* let succ n = add n 1L */ +external succ: int64 => int64 = "?int64_succ" +let pred = n => sub(n, 1L) +let abs = n => + if n >= 0L { + n + } else { + neg(n) + } +let min_int = 0x8000000000000000L +let max_int = 0x7FFFFFFFFFFFFFFFL +let lognot = n => logxor(n, -1L) + +external format: (string, int64) => string = "?int64_format" +external to_string: int64 => string = "?int64_to_string" + +external of_string: string => int64 = "?int64_of_string" + +let of_string_opt = s => + /* TODO: expose a non-raising primitive directly. */ + try Some(of_string(s)) catch { + | Failure(_) => None + } + +external bits_of_float: float => int64 = "?int64_bits_of_float" + +external float_of_bits: int64 => float = "?int64_float_of_bits" + +type t = int64 + +let compare = (x: t, y: t) => Pervasives.compare(x, y) +let equal = (x: t, y: t) => compare(x, y) == 0 diff --git a/jscomp/stdlib-406/int64.resi b/jscomp/stdlib-406/int64.resi new file mode 100644 index 0000000000..c1fc5cff4a --- /dev/null +++ b/jscomp/stdlib-406/int64.resi @@ -0,0 +1,191 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" 64-bit integers. + + This module provides operations on the type [int64] of + signed 64-bit integers. Unlike the built-in [int] type, + the type [int64] is guaranteed to be exactly 64-bit wide on all + platforms. All arithmetic operations over [int64] are taken + modulo 2{^64} + + Performance notice: values of type [int64] occupy more memory + space than values of type [int], and arithmetic operations on + [int64] are generally slower than those on [int]. Use [int64] + only when the application requires exact 64-bit arithmetic. +") + +@ocaml.doc(" The 64-bit integer 0. ") +let zero: int64 + +@ocaml.doc(" The 64-bit integer 1. ") +let one: int64 + +@ocaml.doc(" The 64-bit integer -1. ") +let minus_one: int64 + +@ocaml.doc(" Unary negation. ") +external neg: int64 => int64 = "%int64_neg" + +@ocaml.doc(" Addition. ") +external add: (int64, int64) => int64 = "%int64_add" + +@ocaml.doc(" Subtraction. ") +external sub: (int64, int64) => int64 = "%int64_sub" + +@ocaml.doc(" Multiplication. ") +external mul: (int64, int64) => int64 = "%int64_mul" + +@ocaml.doc(" Integer division. Raise [Division_by_zero] if the second + argument is zero. This division rounds the real quotient of + its arguments towards zero, as specified for {!Pervasives.(/)}. ") +external div: (int64, int64) => int64 = "%int64_div" + +@ocaml.doc(" Integer remainder. If [y] is not zero, the result + of [Int64.rem x y] satisfies the following property: + [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)]. + If [y = 0], [Int64.rem x y] raises [Division_by_zero]. ") +external rem: (int64, int64) => int64 = "%int64_mod" + +@ocaml.doc(" Successor. [Int64.succ x] is [Int64.add x Int64.one]. ") +let succ: int64 => int64 + +@ocaml.doc(" Predecessor. [Int64.pred x] is [Int64.sub x Int64.one]. ") +let pred: int64 => int64 + +@ocaml.doc(" Return the absolute value of its argument. ") +let abs: int64 => int64 + +@ocaml.doc(" The greatest representable 64-bit integer, 2{^63} - 1. ") +let max_int: int64 + +@ocaml.doc(" The smallest representable 64-bit integer, -2{^63}. ") +let min_int: int64 + +@ocaml.doc(" Bitwise logical and. ") +external logand: (int64, int64) => int64 = "%int64_and" + +@ocaml.doc(" Bitwise logical or. ") +external logor: (int64, int64) => int64 = "%int64_or" + +@ocaml.doc(" Bitwise logical exclusive or. ") +external logxor: (int64, int64) => int64 = "%int64_xor" + +@ocaml.doc(" Bitwise logical negation. ") +let lognot: int64 => int64 + +@ocaml.doc(" [Int64.shift_left x y] shifts [x] to the left by [y] bits. + The result is unspecified if [y < 0] or [y >= 64]. ") +external shift_left: (int64, int) => int64 = "%int64_lsl" + +@ocaml.doc(" [Int64.shift_right x y] shifts [x] to the right by [y] bits. + This is an arithmetic shift: the sign bit of [x] is replicated + and inserted in the vacated bits. + The result is unspecified if [y < 0] or [y >= 64]. ") +external shift_right: (int64, int) => int64 = "%int64_asr" + +@ocaml.doc(" [Int64.shift_right_logical x y] shifts [x] to the right by [y] bits. + This is a logical shift: zeroes are inserted in the vacated bits + regardless of the sign of [x]. + The result is unspecified if [y < 0] or [y >= 64]. ") +external shift_right_logical: (int64, int) => int64 = "%int64_lsr" + +@ocaml.doc(" Convert the given integer (type [int]) to a 64-bit integer + (type [int64]). ") +external of_int: int => int64 = "%int64_of_int" + +@ocaml.doc(" Convert the given 64-bit integer (type [int64]) to an + integer (type [int]). On 64-bit platforms, the 64-bit integer + is taken modulo 2{^63}, i.e. the high-order bit is lost + during the conversion. On 32-bit platforms, the 64-bit integer + is taken modulo 2{^31}, i.e. the top 33 bits are lost + during the conversion. ") +external to_int: int64 => int = "%int64_to_int" + +@ocaml.doc(" Convert the given floating-point number to a 64-bit integer, + discarding the fractional part (truncate towards 0). + The result of the conversion is undefined if, after truncation, + the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. ") +external of_float: float => int64 = "?int64_of_float" + +@ocaml.doc(" Convert the given 64-bit integer to a floating-point number. ") +external to_float: int64 => float = "?int64_to_float" + +@ocaml.doc(" Convert the given 32-bit integer (type [int]) + to a 64-bit integer (type [int64]). ") +external of_int32: int => int64 = "%int64_of_int32" + +@ocaml.doc(" Convert the given 64-bit integer (type [int64]) to a + 32-bit integer (type [int]). The 64-bit integer + is taken modulo 2{^32}, i.e. the top 32 bits are lost + during the conversion. ") +external to_int32: int64 => int = "%int64_to_int32" + +@ocaml.doc(" Convert the given string to a 64-bit integer. + The string is read in decimal (by default, or if the string + begins with [0u]) or in hexadecimal, octal or binary if the + string begins with [0x], [0o] or [0b] respectively. + + The [0u] prefix reads the input as an unsigned integer in the range + [[0, 2*Int64.max_int+1]]. If the input exceeds {!Int64.max_int} + it is converted to the signed integer + [Int64.min_int + input - Int64.max_int - 1]. + + The [_] (underscore) character can appear anywhere in the string + and is ignored. + Raise [Failure \"Int64.of_string\"] if the given string is not + a valid representation of an integer, or if the integer represented + exceeds the range of integers representable in type [int64]. ") +external of_string: string => int64 = "?int64_of_string" + +@ocaml.doc(" Same as [of_string], but return [None] instead of raising. + @since 4.05 ") +let of_string_opt: string => option + +@ocaml.doc(" Return the string representation of its argument, in decimal. ") +let to_string: int64 => string + +@ocaml.doc(" Return the internal representation of the given float according + to the IEEE 754 floating-point 'double format' bit layout. + Bit 63 of the result represents the sign of the float; + bits 62 to 52 represent the (biased) exponent; bits 51 to 0 + represent the mantissa. ") +external bits_of_float: float => int64 = "?int64_bits_of_float" + +@ocaml.doc(" Return the floating-point number whose internal representation, + according to the IEEE 754 floating-point 'double format' bit layout, + is the given [int64]. ") +external float_of_bits: int64 => float = "?int64_float_of_bits" + +@ocaml.doc(" An alias for the type of 64-bit integers. ") +type t = int64 + +@ocaml.doc(" The comparison function for 64-bit integers, with the same specification as + {!Pervasives.compare}. Along with the type [t], this function [compare] + allows the module [Int64] to be passed as argument to the functors + {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int + +@ocaml.doc(" The equal function for int64s. + @since 4.03.0 ") +let equal: (t, t) => bool + +@@ocaml.text("/*") + +@@ocaml.text(" {1 Deprecated functions} ") + +@ocaml.doc(" Do not use this deprecated function. Instead, + used {!Printf.sprintf} with a [%L...] format. ") +external format: (string, int64) => string = "?int64_format" diff --git a/jscomp/stdlib-406/lazy.ml b/jscomp/stdlib-406/lazy.ml deleted file mode 100644 index 4ee3003a0a..0000000000 --- a/jscomp/stdlib-406/lazy.ml +++ /dev/null @@ -1,70 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Para, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(* Module [Lazy]: deferred computations *) - - -(* - WARNING: some purple magic is going on here. Do not take this file - as an example of how to program in OCaml. -*) - - -(* We make use of two special tags provided by the runtime: - [lazy_tag] and [forward_tag]. - - A value of type ['a Lazy.t] can be one of three things: - 1. A block of size 1 with tag [lazy_tag]. Its field is a closure of - type [unit -> 'a] that computes the value. - 2. A block of size 1 with tag [forward_tag]. Its field is the value - of type ['a] that was computed. - 3. Anything else except a float. This has type ['a] and is the value - that was computed. - Exceptions are stored in format (1). - The GC will magically change things from (2) to (3) according to its - fancy. - - If OCaml was configured with the -flat-float-array option (which is - currently the default), the following is also true: - We cannot use representation (3) for a [float Lazy.t] because - [caml_make_array] assumes that only a [float] value can have tag - [Double_tag]. - - We have to use the built-in type constructor [lazy_t] to - let the compiler implement the special typing and compilation - rules for the [lazy] keyword. -*) - -type 'a t = 'a lazy_t - -exception Undefined = CamlinternalLazy.Undefined - -external force : 'a t -> 'a = "%lazy_force" - -(* let force = force *) - -let force_val = CamlinternalLazy.force_val - -let from_fun f = lazy (f ()) - -let from_val v = lazy v - -let is_val = CamlinternalLazy.is_val - -let lazy_from_fun = from_fun - -let lazy_from_val = from_val - -let lazy_is_val = is_val diff --git a/jscomp/stdlib-406/lazy.mli b/jscomp/stdlib-406/lazy.mli deleted file mode 100644 index ee10366ee8..0000000000 --- a/jscomp/stdlib-406/lazy.mli +++ /dev/null @@ -1,95 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Para, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Deferred computations. *) - -type 'a t = 'a lazy_t -(** A value of type ['a Lazy.t] is a deferred computation, called - a suspension, that has a result of type ['a]. The special - expression syntax [lazy (expr)] makes a suspension of the - computation of [expr], without computing [expr] itself yet. - "Forcing" the suspension will then compute [expr] and return its - result. - - Note: [lazy_t] is the built-in type constructor used by the compiler - for the [lazy] keyword. You should not use it directly. Always use - [Lazy.t] instead. - - Note: [Lazy.force] is not thread-safe. If you use this module in - a multi-threaded program, you will need to add some locks. - - Note: if the program is compiled with the [-rectypes] option, - ill-founded recursive definitions of the form [let rec x = lazy x] - or [let rec x = lazy(lazy(...(lazy x)))] are accepted by the type-checker - and lead, when forced, to ill-formed values that trigger infinite - loops in the garbage collector and other parts of the run-time system. - Without the [-rectypes] option, such ill-founded recursive definitions - are rejected by the type-checker. -*) - - -exception Undefined - -(* val force : 'a t -> 'a *) -external force : 'a t -> 'a = "%lazy_force" -(** [force x] forces the suspension [x] and returns its result. - If [x] has already been forced, [Lazy.force x] returns the - same value again without recomputing it. If it raised an exception, - the same exception is raised again. - Raise {!Undefined} if the forcing of [x] tries to force [x] itself - recursively. -*) - -val force_val : 'a t -> 'a -(** [force_val x] forces the suspension [x] and returns its - result. If [x] has already been forced, [force_val x] - returns the same value again without recomputing it. - Raise {!Undefined} if the forcing of [x] tries to force [x] itself - recursively. - If the computation of [x] raises an exception, it is unspecified - whether [force_val x] raises the same exception or {!Undefined}. -*) - -val from_fun : (unit -> 'a) -> 'a t -(** [from_fun f] is the same as [lazy (f ())] but slightly more efficient. - - [from_fun] should only be used if the function [f] is already defined. - In particular it is always less efficient to write - [from_fun (fun () -> expr)] than [lazy expr]. - - @since 4.00.0 *) - -val from_val : 'a -> 'a t -(** [from_val v] returns an already-forced suspension of [v]. - This is for special purposes only and should not be confused with - [lazy (v)]. - @since 4.00.0 *) - -val is_val : 'a t -> bool -(** [is_val x] returns [true] if [x] has already been forced and - did not raise an exception. - @since 4.00.0 *) - -val lazy_from_fun : (unit -> 'a) -> 'a t - [@@ocaml.deprecated "Use Lazy.from_fun instead."] -(** @deprecated synonym for [from_fun]. *) - -val lazy_from_val : 'a -> 'a t - [@@ocaml.deprecated "Use Lazy.from_val instead."] -(** @deprecated synonym for [from_val]. *) - -val lazy_is_val : 'a t -> bool - [@@ocaml.deprecated "Use Lazy.is_val instead."] -(** @deprecated synonym for [is_val]. *) diff --git a/jscomp/stdlib-406/lazy.res b/jscomp/stdlib-406/lazy.res new file mode 100644 index 0000000000..967946d257 --- /dev/null +++ b/jscomp/stdlib-406/lazy.res @@ -0,0 +1,68 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +/* Module [Lazy]: deferred computations */ + +/* + WARNING: some purple magic is going on here. Do not take this file + as an example of how to program in OCaml. +*/ + +/* We make use of two special tags provided by the runtime: + [lazy_tag] and [forward_tag]. + + A value of type ['a Lazy.t] can be one of three things: + 1. A block of size 1 with tag [lazy_tag]. Its field is a closure of + type [unit -> 'a] that computes the value. + 2. A block of size 1 with tag [forward_tag]. Its field is the value + of type ['a] that was computed. + 3. Anything else except a float. This has type ['a] and is the value + that was computed. + Exceptions are stored in format (1). + The GC will magically change things from (2) to (3) according to its + fancy. + + If OCaml was configured with the -flat-float-array option (which is + currently the default), the following is also true: + We cannot use representation (3) for a [float Lazy.t] because + [caml_make_array] assumes that only a [float] value can have tag + [Double_tag]. + + We have to use the built-in type constructor [lazy_t] to + let the compiler implement the special typing and compilation + rules for the [lazy] keyword. +*/ + +type t<'a> = lazy_t<'a> + +exception Undefined = CamlinternalLazy.Undefined + +external force: t<'a> => 'a = "%lazy_force" + +/* let force = force */ + +let force_val = CamlinternalLazy.force_val + +let from_fun = f => lazy f() + +let from_val = v => lazy v + +let is_val = CamlinternalLazy.is_val + +let lazy_from_fun = from_fun + +let lazy_from_val = from_val + +let lazy_is_val = is_val diff --git a/jscomp/stdlib-406/lazy.resi b/jscomp/stdlib-406/lazy.resi new file mode 100644 index 0000000000..42bbcf2714 --- /dev/null +++ b/jscomp/stdlib-406/lazy.resi @@ -0,0 +1,93 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* OCaml */ + /* */ + /* Damien Doligez, projet Para, INRIA Rocquencourt */ + /* */ + /* Copyright 1997 Institut National de Recherche en Informatique et */ + /* en Automatique. */ + /* */ + /* All rights reserved. This file is distributed under the terms of */ + /* the GNU Lesser General Public License version 2.1, with the */ + /* special exception on linking described in the file LICENSE. */ + /* */ + /* ************************************************************************ */ + + " Deferred computations. " +) + +@ocaml.doc(" A value of type ['a Lazy.t] is a deferred computation, called + a suspension, that has a result of type ['a]. The special + expression syntax [lazy (expr)] makes a suspension of the + computation of [expr], without computing [expr] itself yet. + \"Forcing\" the suspension will then compute [expr] and return its + result. + + Note: [lazy_t] is the built-in type constructor used by the compiler + for the [lazy] keyword. You should not use it directly. Always use + [Lazy.t] instead. + + Note: [Lazy.force] is not thread-safe. If you use this module in + a multi-threaded program, you will need to add some locks. + + Note: if the program is compiled with the [-rectypes] option, + ill-founded recursive definitions of the form [let rec x = lazy x] + or [let rec x = lazy(lazy(...(lazy x)))] are accepted by the type-checker + and lead, when forced, to ill-formed values that trigger infinite + loops in the garbage collector and other parts of the run-time system. + Without the [-rectypes] option, such ill-founded recursive definitions + are rejected by the type-checker. +") +type t<'a> = lazy_t<'a> + +exception Undefined + +/* val force : 'a t -> 'a */ +@ocaml.doc(" [force x] forces the suspension [x] and returns its result. + If [x] has already been forced, [Lazy.force x] returns the + same value again without recomputing it. If it raised an exception, + the same exception is raised again. + Raise {!Undefined} if the forcing of [x] tries to force [x] itself + recursively. +") +external force: t<'a> => 'a = "%lazy_force" + +@ocaml.doc(" [force_val x] forces the suspension [x] and returns its + result. If [x] has already been forced, [force_val x] + returns the same value again without recomputing it. + Raise {!Undefined} if the forcing of [x] tries to force [x] itself + recursively. + If the computation of [x] raises an exception, it is unspecified + whether [force_val x] raises the same exception or {!Undefined}. +") +let force_val: t<'a> => 'a + +@ocaml.doc(" [from_fun f] is the same as [lazy (f ())] but slightly more efficient. + + [from_fun] should only be used if the function [f] is already defined. + In particular it is always less efficient to write + [from_fun (fun () -> expr)] than [lazy expr]. + + @since 4.00.0 ") +let from_fun: (unit => 'a) => t<'a> + +@ocaml.doc(" [from_val v] returns an already-forced suspension of [v]. + This is for special purposes only and should not be confused with + [lazy (v)]. + @since 4.00.0 ") +let from_val: 'a => t<'a> + +@ocaml.doc(" [is_val x] returns [true] if [x] has already been forced and + did not raise an exception. + @since 4.00.0 ") +let is_val: t<'a> => bool + +@ocaml.deprecated("Use Lazy.from_fun instead.") @ocaml.doc(" @deprecated synonym for [from_fun]. ") +let lazy_from_fun: (unit => 'a) => t<'a> + +@ocaml.deprecated("Use Lazy.from_val instead.") @ocaml.doc(" @deprecated synonym for [from_val]. ") +let lazy_from_val: 'a => t<'a> + +@ocaml.deprecated("Use Lazy.is_val instead.") @ocaml.doc(" @deprecated synonym for [is_val]. ") +let lazy_is_val: t<'a> => bool diff --git a/jscomp/stdlib-406/lexing.ml b/jscomp/stdlib-406/lexing.ml deleted file mode 100644 index 79a32da5d5..0000000000 --- a/jscomp/stdlib-406/lexing.ml +++ /dev/null @@ -1,230 +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. *) -(* *) -(**************************************************************************) - -(* The run-time library for lexers generated by camllex *) - -type position = { - pos_fname : string; - pos_lnum : int; - pos_bol : int; - pos_cnum : int; -} - -let dummy_pos = { - pos_fname = ""; - pos_lnum = 0; - pos_bol = 0; - pos_cnum = -1; -} - -type lexbuf = - { refill_buff : lexbuf -> unit; - mutable lex_buffer : bytes; - mutable lex_buffer_len : int; - mutable lex_abs_pos : int; - mutable lex_start_pos : int; - mutable lex_curr_pos : int; - mutable lex_last_pos : int; - mutable lex_last_action : int; - mutable lex_eof_reached : bool; - mutable lex_mem : int array; - mutable lex_start_p : position; - mutable lex_curr_p : position; - } - -type lex_tables = - { lex_base: string; - lex_backtrk: string; - lex_default: string; - lex_trans: string; - lex_check: string; - lex_base_code : string; - lex_backtrk_code : string; - lex_default_code : string; - lex_trans_code : string; - lex_check_code : string; - lex_code: string;} - -external c_engine : lex_tables -> int -> lexbuf -> int = "?lex_engine" -external c_new_engine : lex_tables -> int -> lexbuf -> int - = "?new_lex_engine" - -let engine tbl state buf = - let result = c_engine tbl state buf in - if result >= 0 then begin - buf.lex_start_p <- buf.lex_curr_p; - buf.lex_curr_p <- {buf.lex_curr_p - with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos}; - end; - result - - -let new_engine tbl state buf = - let result = c_new_engine tbl state buf in - if result >= 0 then begin - buf.lex_start_p <- buf.lex_curr_p; - buf.lex_curr_p <- {buf.lex_curr_p - with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos}; - end; - result - - -let lex_refill read_fun aux_buffer lexbuf = - let read = - read_fun aux_buffer (Bytes.length aux_buffer) in - let n = - if read > 0 - then read - else (lexbuf.lex_eof_reached <- true; 0) in - (* Current state of the buffer: - <-------|---------------------|-----------> - | junk | valid data | junk | - ^ ^ ^ ^ - 0 start_pos buffer_end Bytes.length buffer - *) - if lexbuf.lex_buffer_len + n > Bytes.length lexbuf.lex_buffer then begin - (* There is not enough space at the end of the buffer *) - if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n - <= Bytes.length lexbuf.lex_buffer - then begin - (* But there is enough space if we reclaim the junk at the beginning - of the buffer *) - Bytes.blit lexbuf.lex_buffer lexbuf.lex_start_pos - lexbuf.lex_buffer 0 - (lexbuf.lex_buffer_len - lexbuf.lex_start_pos) - end else begin - (* We must grow the buffer. Doubling its size will provide enough - space since n <= String.length aux_buffer <= String.length buffer. - Watch out for string length overflow, though. *) - let newlen = - (2 * Bytes.length lexbuf.lex_buffer) - in - if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen - then failwith "Lexing.lex_refill: cannot grow buffer"; - let newbuf = Bytes.create newlen in - (* Copy the valid data to the beginning of the new buffer *) - Bytes.blit lexbuf.lex_buffer lexbuf.lex_start_pos - newbuf 0 - (lexbuf.lex_buffer_len - lexbuf.lex_start_pos); - lexbuf.lex_buffer <- newbuf - end; - (* Reallocation or not, we have shifted the data left by - start_pos characters; update the positions *) - let s = lexbuf.lex_start_pos in - lexbuf.lex_abs_pos <- lexbuf.lex_abs_pos + s; - lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - s; - lexbuf.lex_start_pos <- 0; - lexbuf.lex_last_pos <- lexbuf.lex_last_pos - s; - lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len - s ; - let t = lexbuf.lex_mem in - for i = 0 to Array.length t-1 do - let v = t.(i) in - if v >= 0 then - t.(i) <- v-s - done - end; - (* There is now enough space at the end of the buffer *) - Bytes.blit aux_buffer 0 lexbuf.lex_buffer lexbuf.lex_buffer_len n; - lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len + n - -let zero_pos = { - pos_fname = ""; - pos_lnum = 1; - pos_bol = 0; - pos_cnum = 0; -} - -let from_function f = - { refill_buff = lex_refill f (Bytes.create 512); - lex_buffer = Bytes.create 1024; - lex_buffer_len = 0; - lex_abs_pos = 0; - lex_start_pos = 0; - lex_curr_pos = 0; - lex_last_pos = 0; - lex_last_action = 0; - lex_mem = [||]; - lex_eof_reached = false; - lex_start_p = zero_pos; - lex_curr_p = zero_pos; - } - - -let from_string s = - { refill_buff = (fun lexbuf -> lexbuf.lex_eof_reached <- true); - lex_buffer = Bytes.of_string s; (* have to make a copy for compatibility - with unsafe-string mode *) - lex_buffer_len = String.length s; - lex_abs_pos = 0; - lex_start_pos = 0; - lex_curr_pos = 0; - lex_last_pos = 0; - lex_last_action = 0; - lex_mem = [||]; - lex_eof_reached = true; - lex_start_p = zero_pos; - lex_curr_p = zero_pos; - } - -let lexeme lexbuf = - let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in - Bytes.sub_string lexbuf.lex_buffer lexbuf.lex_start_pos len - -let sub_lexeme lexbuf i1 i2 = - let len = i2-i1 in - Bytes.sub_string lexbuf.lex_buffer i1 len - -let sub_lexeme_opt lexbuf i1 i2 = - if i1 >= 0 then begin - let len = i2-i1 in - Some (Bytes.sub_string lexbuf.lex_buffer i1 len) - end else begin - None - end - -let sub_lexeme_char lexbuf i = Bytes.get lexbuf.lex_buffer i - -let sub_lexeme_char_opt lexbuf i = - if i >= 0 then - Some (Bytes.get lexbuf.lex_buffer i) - else - None - - -let lexeme_char lexbuf i = - Bytes.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i) - -let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum -let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum - -let lexeme_start_p lexbuf = lexbuf.lex_start_p -let lexeme_end_p lexbuf = lexbuf.lex_curr_p - -let new_line lexbuf = - let lcp = lexbuf.lex_curr_p in - lexbuf.lex_curr_p <- { lcp with - pos_lnum = lcp.pos_lnum + 1; - pos_bol = lcp.pos_cnum; - } - - - -(* Discard data left in lexer buffer. *) - -let flush_input lb = - lb.lex_curr_pos <- 0; - lb.lex_abs_pos <- 0; - lb.lex_curr_p <- {lb.lex_curr_p with pos_cnum = 0}; - lb.lex_buffer_len <- 0; diff --git a/jscomp/stdlib-406/lexing.mli b/jscomp/stdlib-406/lexing.mli deleted file mode 100644 index c886487361..0000000000 --- a/jscomp/stdlib-406/lexing.mli +++ /dev/null @@ -1,172 +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. *) -(* *) -(**************************************************************************) - -(** The run-time library for lexers generated by [ocamllex]. *) - -(** {1 Positions} *) - -type position = { - pos_fname : string; - pos_lnum : int; - pos_bol : int; - pos_cnum : int; -} -(** A value of type [position] describes a point in a source file. - [pos_fname] is the file name; [pos_lnum] is the line number; - [pos_bol] is the offset of the beginning of the line (number - of characters between the beginning of the lexbuf and the beginning - of the line); [pos_cnum] is the offset of the position (number of - characters between the beginning of the lexbuf and the position). - The difference between [pos_cnum] and [pos_bol] is the character - offset within the line (i.e. the column number, assuming each - character is one column wide). - - See the documentation of type [lexbuf] for information about - how the lexing engine will manage positions. - *) - -val dummy_pos : position -(** A value of type [position], guaranteed to be different from any - valid position. - *) - - -(** {1 Lexer buffers} *) - - -type lexbuf = - { refill_buff : lexbuf -> unit; - mutable lex_buffer : bytes; - mutable lex_buffer_len : int; - mutable lex_abs_pos : int; - mutable lex_start_pos : int; - mutable lex_curr_pos : int; - mutable lex_last_pos : int; - mutable lex_last_action : int; - mutable lex_eof_reached : bool; - mutable lex_mem : int array; - mutable lex_start_p : position; - mutable lex_curr_p : position; - } -(** The type of lexer buffers. A lexer buffer is the argument passed - to the scanning functions defined by the generated scanners. - The lexer buffer holds the current state of the scanner, plus - a function to refill the buffer from the input. - - At each token, the lexing engine will copy [lex_curr_p] to - [lex_start_p], then change the [pos_cnum] field - of [lex_curr_p] by updating it with the number of characters read - since the start of the [lexbuf]. The other fields are left - unchanged by the lexing engine. In order to keep them - accurate, they must be initialised before the first use of the - lexbuf, and updated by the relevant lexer actions (i.e. at each - end of line -- see also [new_line]). - *) - - -val from_string : string -> lexbuf -(** Create a lexer buffer which reads from - the given string. Reading starts from the first character in - the string. An end-of-input condition is generated when the - end of the string is reached. *) - -val from_function : (bytes -> int -> int) -> lexbuf -(** Create a lexer buffer with the given function as its reading method. - When the scanner needs more characters, it will call the given - function, giving it a byte sequence [s] and a byte - count [n]. The function should put [n] bytes or fewer in [s], - starting at index 0, and return the number of bytes - provided. A return value of 0 means end of input. *) - - -(** {1 Functions for lexer semantic actions} *) - - -(** The following functions can be called from the semantic actions - of lexer definitions (the ML code enclosed in braces that - computes the value returned by lexing functions). They give - access to the character string matched by the regular expression - associated with the semantic action. These functions must be - applied to the argument [lexbuf], which, in the code generated by - [ocamllex], is bound to the lexer buffer passed to the parsing - function. *) - -val lexeme : lexbuf -> string -(** [Lexing.lexeme lexbuf] returns the string matched by - the regular expression. *) - -val lexeme_char : lexbuf -> int -> char -(** [Lexing.lexeme_char lexbuf i] returns character number [i] in - the matched string. *) - -val lexeme_start : lexbuf -> int -(** [Lexing.lexeme_start lexbuf] returns the offset in the - input stream of the first character of the matched string. - The first character of the stream has offset 0. *) - -val lexeme_end : lexbuf -> int -(** [Lexing.lexeme_end lexbuf] returns the offset in the input stream - of the character following the last character of the matched - string. The first character of the stream has offset 0. *) - -val lexeme_start_p : lexbuf -> position -(** Like [lexeme_start], but return a complete [position] instead - of an offset. *) - -val lexeme_end_p : lexbuf -> position -(** Like [lexeme_end], but return a complete [position] instead - of an offset. *) - -val new_line : lexbuf -> unit -(** Update the [lex_curr_p] field of the lexbuf to reflect the start - of a new line. You can call this function in the semantic action - of the rule that matches the end-of-line character. - @since 3.11.0 -*) - -(** {1 Miscellaneous functions} *) - -val flush_input : lexbuf -> unit -(** Discard the contents of the buffer and reset the current - position to 0. The next use of the lexbuf will trigger a - refill. *) - -(**/**) - -(** {1 } *) - -(** The following definitions are used by the generated scanners only. - They are not intended to be used directly by user programs. *) - -val sub_lexeme : lexbuf -> int -> int -> string -val sub_lexeme_opt : lexbuf -> int -> int -> string option -val sub_lexeme_char : lexbuf -> int -> char -val sub_lexeme_char_opt : lexbuf -> int -> char option - -type lex_tables = - { lex_base : string; - lex_backtrk : string; - lex_default : string; - lex_trans : string; - lex_check : string; - lex_base_code : string; - lex_backtrk_code : string; - lex_default_code : string; - lex_trans_code : string; - lex_check_code : string; - lex_code: string;} - -val engine : lex_tables -> int -> lexbuf -> int -val new_engine : lex_tables -> int -> lexbuf -> int diff --git a/jscomp/stdlib-406/lexing.res b/jscomp/stdlib-406/lexing.res new file mode 100644 index 0000000000..2773ecb4cf --- /dev/null +++ b/jscomp/stdlib-406/lexing.res @@ -0,0 +1,245 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* The run-time library for lexers generated by camllex */ + +type position = { + pos_fname: string, + pos_lnum: int, + pos_bol: int, + pos_cnum: int, +} + +let dummy_pos = { + pos_fname: "", + pos_lnum: 0, + pos_bol: 0, + pos_cnum: -1, +} + +type rec lexbuf = { + refill_buff: lexbuf => unit, + mutable lex_buffer: bytes, + mutable lex_buffer_len: int, + mutable lex_abs_pos: int, + mutable lex_start_pos: int, + mutable lex_curr_pos: int, + mutable lex_last_pos: int, + mutable lex_last_action: int, + mutable lex_eof_reached: bool, + mutable lex_mem: array, + mutable lex_start_p: position, + mutable lex_curr_p: position, +} + +type lex_tables = { + lex_base: string, + lex_backtrk: string, + lex_default: string, + lex_trans: string, + lex_check: string, + lex_base_code: string, + lex_backtrk_code: string, + lex_default_code: string, + lex_trans_code: string, + lex_check_code: string, + lex_code: string, +} + +external c_engine: (lex_tables, int, lexbuf) => int = "?lex_engine" +external c_new_engine: (lex_tables, int, lexbuf) => int = "?new_lex_engine" + +let engine = (tbl, state, buf) => { + let result = c_engine(tbl, state, buf) + if result >= 0 { + buf.lex_start_p = buf.lex_curr_p + buf.lex_curr_p = { + ...buf.lex_curr_p, + pos_cnum: buf.lex_abs_pos + buf.lex_curr_pos, + } + } + result +} + +let new_engine = (tbl, state, buf) => { + let result = c_new_engine(tbl, state, buf) + if result >= 0 { + buf.lex_start_p = buf.lex_curr_p + buf.lex_curr_p = { + ...buf.lex_curr_p, + pos_cnum: buf.lex_abs_pos + buf.lex_curr_pos, + } + } + result +} + +let lex_refill = (read_fun, aux_buffer, lexbuf) => { + let read = read_fun(aux_buffer, Bytes.length(aux_buffer)) + let n = if read > 0 { + read + } else { + lexbuf.lex_eof_reached = true + 0 + } + + /* Current state of the buffer: + <-------|---------------------|-----------> + | junk | valid data | junk | + ^ ^ ^ ^ + 0 start_pos buffer_end Bytes.length buffer + */ + if lexbuf.lex_buffer_len + n > Bytes.length(lexbuf.lex_buffer) { + /* There is not enough space at the end of the buffer */ + if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n <= Bytes.length(lexbuf.lex_buffer) { + /* But there is enough space if we reclaim the junk at the beginning + of the buffer */ + Bytes.blit( + lexbuf.lex_buffer, + lexbuf.lex_start_pos, + lexbuf.lex_buffer, + 0, + lexbuf.lex_buffer_len - lexbuf.lex_start_pos, + ) + } else { + /* We must grow the buffer. Doubling its size will provide enough + space since n <= String.length aux_buffer <= String.length buffer. + Watch out for string length overflow, though. */ + let newlen = 2 * Bytes.length(lexbuf.lex_buffer) + + if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen { + failwith("Lexing.lex_refill: cannot grow buffer") + } + let newbuf = Bytes.create(newlen) + /* Copy the valid data to the beginning of the new buffer */ + Bytes.blit( + lexbuf.lex_buffer, + lexbuf.lex_start_pos, + newbuf, + 0, + lexbuf.lex_buffer_len - lexbuf.lex_start_pos, + ) + lexbuf.lex_buffer = newbuf + } + /* Reallocation or not, we have shifted the data left by + start_pos characters; update the positions */ + let s = lexbuf.lex_start_pos + lexbuf.lex_abs_pos = lexbuf.lex_abs_pos + s + lexbuf.lex_curr_pos = lexbuf.lex_curr_pos - s + lexbuf.lex_start_pos = 0 + lexbuf.lex_last_pos = lexbuf.lex_last_pos - s + lexbuf.lex_buffer_len = lexbuf.lex_buffer_len - s + let t = lexbuf.lex_mem + for i in 0 to Array.length(t) - 1 { + let v = t[i] + if v >= 0 { + t[i] = v - s + } + } + } + /* There is now enough space at the end of the buffer */ + Bytes.blit(aux_buffer, 0, lexbuf.lex_buffer, lexbuf.lex_buffer_len, n) + lexbuf.lex_buffer_len = lexbuf.lex_buffer_len + n +} + +let zero_pos = { + pos_fname: "", + pos_lnum: 1, + pos_bol: 0, + pos_cnum: 0, +} + +let from_function = f => { + refill_buff: lex_refill(f, Bytes.create(512)), + lex_buffer: Bytes.create(1024), + lex_buffer_len: 0, + lex_abs_pos: 0, + lex_start_pos: 0, + lex_curr_pos: 0, + lex_last_pos: 0, + lex_last_action: 0, + lex_mem: [], + lex_eof_reached: false, + lex_start_p: zero_pos, + lex_curr_p: zero_pos, +} + +let from_string = s => { + refill_buff: lexbuf => lexbuf.lex_eof_reached = true, + lex_buffer: Bytes.of_string(s) /* have to make a copy for compatibility + with unsafe-string mode */, + lex_buffer_len: String.length(s), + lex_abs_pos: 0, + lex_start_pos: 0, + lex_curr_pos: 0, + lex_last_pos: 0, + lex_last_action: 0, + lex_mem: [], + lex_eof_reached: true, + lex_start_p: zero_pos, + lex_curr_p: zero_pos, +} + +let lexeme = lexbuf => { + let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos + Bytes.sub_string(lexbuf.lex_buffer, lexbuf.lex_start_pos, len) +} + +let sub_lexeme = (lexbuf, i1, i2) => { + let len = i2 - i1 + Bytes.sub_string(lexbuf.lex_buffer, i1, len) +} + +let sub_lexeme_opt = (lexbuf, i1, i2) => + if i1 >= 0 { + let len = i2 - i1 + Some(Bytes.sub_string(lexbuf.lex_buffer, i1, len)) + } else { + None + } + +let sub_lexeme_char = (lexbuf, i) => Bytes.get(lexbuf.lex_buffer, i) + +let sub_lexeme_char_opt = (lexbuf, i) => + if i >= 0 { + Some(Bytes.get(lexbuf.lex_buffer, i)) + } else { + None + } + +let lexeme_char = (lexbuf, i) => Bytes.get(lexbuf.lex_buffer, lexbuf.lex_start_pos + i) + +let lexeme_start = lexbuf => lexbuf.lex_start_p.pos_cnum +let lexeme_end = lexbuf => lexbuf.lex_curr_p.pos_cnum + +let lexeme_start_p = lexbuf => lexbuf.lex_start_p +let lexeme_end_p = lexbuf => lexbuf.lex_curr_p + +let new_line = lexbuf => { + let lcp = lexbuf.lex_curr_p + lexbuf.lex_curr_p = { + ...lcp, + pos_lnum: lcp.pos_lnum + 1, + pos_bol: lcp.pos_cnum, + } +} + +/* Discard data left in lexer buffer. */ + +let flush_input = lb => { + lb.lex_curr_pos = 0 + lb.lex_abs_pos = 0 + lb.lex_curr_p = {...lb.lex_curr_p, pos_cnum: 0} + lb.lex_buffer_len = 0 +} diff --git a/jscomp/stdlib-406/lexing.resi b/jscomp/stdlib-406/lexing.resi new file mode 100644 index 0000000000..705e02071d --- /dev/null +++ b/jscomp/stdlib-406/lexing.resi @@ -0,0 +1,170 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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. */ + /* */ + /* ************************************************************************ */ + + " The run-time library for lexers generated by [ocamllex]. " +) + +@@ocaml.text(" {1 Positions} ") + +@ocaml.doc(" A value of type [position] describes a point in a source file. + [pos_fname] is the file name; [pos_lnum] is the line number; + [pos_bol] is the offset of the beginning of the line (number + of characters between the beginning of the lexbuf and the beginning + of the line); [pos_cnum] is the offset of the position (number of + characters between the beginning of the lexbuf and the position). + The difference between [pos_cnum] and [pos_bol] is the character + offset within the line (i.e. the column number, assuming each + character is one column wide). + + See the documentation of type [lexbuf] for information about + how the lexing engine will manage positions. + ") +type position = { + pos_fname: string, + pos_lnum: int, + pos_bol: int, + pos_cnum: int, +} + +@ocaml.doc(" A value of type [position], guaranteed to be different from any + valid position. + ") +let dummy_pos: position + +@@ocaml.text(" {1 Lexer buffers} ") + +@ocaml.doc(" The type of lexer buffers. A lexer buffer is the argument passed + to the scanning functions defined by the generated scanners. + The lexer buffer holds the current state of the scanner, plus + a function to refill the buffer from the input. + + At each token, the lexing engine will copy [lex_curr_p] to + [lex_start_p], then change the [pos_cnum] field + of [lex_curr_p] by updating it with the number of characters read + since the start of the [lexbuf]. The other fields are left + unchanged by the lexing engine. In order to keep them + accurate, they must be initialised before the first use of the + lexbuf, and updated by the relevant lexer actions (i.e. at each + end of line -- see also [new_line]). + ") +type rec lexbuf = { + refill_buff: lexbuf => unit, + mutable lex_buffer: bytes, + mutable lex_buffer_len: int, + mutable lex_abs_pos: int, + mutable lex_start_pos: int, + mutable lex_curr_pos: int, + mutable lex_last_pos: int, + mutable lex_last_action: int, + mutable lex_eof_reached: bool, + mutable lex_mem: array, + mutable lex_start_p: position, + mutable lex_curr_p: position, +} + +@ocaml.doc(" Create a lexer buffer which reads from + the given string. Reading starts from the first character in + the string. An end-of-input condition is generated when the + end of the string is reached. ") +let from_string: string => lexbuf + +@ocaml.doc(" Create a lexer buffer with the given function as its reading method. + When the scanner needs more characters, it will call the given + function, giving it a byte sequence [s] and a byte + count [n]. The function should put [n] bytes or fewer in [s], + starting at index 0, and return the number of bytes + provided. A return value of 0 means end of input. ") +let from_function: ((bytes, int) => int) => lexbuf + +@@ocaml.text(" {1 Functions for lexer semantic actions} ") + +@@ocaml.text(" The following functions can be called from the semantic actions + of lexer definitions (the ML code enclosed in braces that + computes the value returned by lexing functions). They give + access to the character string matched by the regular expression + associated with the semantic action. These functions must be + applied to the argument [lexbuf], which, in the code generated by + [ocamllex], is bound to the lexer buffer passed to the parsing + function. ") + +@ocaml.doc(" [Lexing.lexeme lexbuf] returns the string matched by + the regular expression. ") +let lexeme: lexbuf => string + +@ocaml.doc(" [Lexing.lexeme_char lexbuf i] returns character number [i] in + the matched string. ") +let lexeme_char: (lexbuf, int) => char + +@ocaml.doc(" [Lexing.lexeme_start lexbuf] returns the offset in the + input stream of the first character of the matched string. + The first character of the stream has offset 0. ") +let lexeme_start: lexbuf => int + +@ocaml.doc(" [Lexing.lexeme_end lexbuf] returns the offset in the input stream + of the character following the last character of the matched + string. The first character of the stream has offset 0. ") +let lexeme_end: lexbuf => int + +@ocaml.doc(" Like [lexeme_start], but return a complete [position] instead + of an offset. ") +let lexeme_start_p: lexbuf => position + +@ocaml.doc(" Like [lexeme_end], but return a complete [position] instead + of an offset. ") +let lexeme_end_p: lexbuf => position + +@ocaml.doc(" Update the [lex_curr_p] field of the lexbuf to reflect the start + of a new line. You can call this function in the semantic action + of the rule that matches the end-of-line character. + @since 3.11.0 +") +let new_line: lexbuf => unit + +@@ocaml.text(" {1 Miscellaneous functions} ") + +@ocaml.doc(" Discard the contents of the buffer and reset the current + position to 0. The next use of the lexbuf will trigger a + refill. ") +let flush_input: lexbuf => unit + +@@ocaml.text("/*") + +@@ocaml.text(" {1 } ") + +@@ocaml.text(" The following definitions are used by the generated scanners only. + They are not intended to be used directly by user programs. ") + +let sub_lexeme: (lexbuf, int, int) => string +let sub_lexeme_opt: (lexbuf, int, int) => option +let sub_lexeme_char: (lexbuf, int) => char +let sub_lexeme_char_opt: (lexbuf, int) => option + +type lex_tables = { + lex_base: string, + lex_backtrk: string, + lex_default: string, + lex_trans: string, + lex_check: string, + lex_base_code: string, + lex_backtrk_code: string, + lex_default_code: string, + lex_trans_code: string, + lex_check_code: string, + lex_code: string, +} + +let engine: (lex_tables, int, lexbuf) => int +let new_engine: (lex_tables, int, lexbuf) => int diff --git a/jscomp/stdlib-406/list.ml b/jscomp/stdlib-406/list.ml deleted file mode 100644 index 5b7b679f58..0000000000 --- a/jscomp/stdlib-406/list.ml +++ /dev/null @@ -1,485 +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. *) -(* *) -(**************************************************************************) - -(* List operations *) - -let rec length_aux len = function - [] -> len - | _::l -> length_aux (len + 1) l - -let length l = length_aux 0 l - -let cons a l = a::l - -let hd = function - [] -> failwith "hd" - | a::_ -> a - -let tl = function - [] -> failwith "tl" - | _::l -> l - -let nth l n = - if n < 0 then invalid_arg "List.nth" else - let rec nth_aux l n = - match l with - | [] -> failwith "nth" - | a::l -> if n = 0 then a else nth_aux l (n-1) - in nth_aux l n - -let nth_opt l n = - if n < 0 then invalid_arg "List.nth" else - let rec nth_aux l n = - match l with - | [] -> None - | a::l -> if n = 0 then Some a else nth_aux l (n-1) - in nth_aux l n - -let append = (@) - -let rec rev_append l1 l2 = - match l1 with - [] -> l2 - | a :: l -> rev_append l (a :: l2) - -let rev l = rev_append l [] - -let rec init_tailrec_aux acc i n f = - if i >= n then acc - else init_tailrec_aux (f i :: acc) (i+1) n f - -let rec init_aux i n f = - if i >= n then [] - else - let r = f i in - r :: init_aux (i+1) n f - -let init len f = - if len < 0 then invalid_arg "List.init" else - if len > 10_000 then rev (init_tailrec_aux [] 0 len f) - else init_aux 0 len f - -let rec flatten = function - [] -> [] - | l::r -> l @ flatten r - -let concat = flatten - -let rec map f = function - [] -> [] - | a::l -> let r = f a in r :: map f l - -let rec mapi i f = function - [] -> [] - | a::l -> let r = f i a in r :: mapi (i + 1) f l - -let mapi f l = mapi 0 f l - -let rev_map f l = - let rec rmap_f accu = function - | [] -> accu - | a::l -> rmap_f (f a :: accu) l - in - rmap_f [] l - - -let rec iter f = function - [] -> () - | a::l -> f a; iter f l - -let rec iteri i f = function - [] -> () - | a::l -> f i a; iteri (i + 1) f l - -let iteri f l = iteri 0 f l - -let rec fold_left f accu l = - match l with - [] -> accu - | a::l -> fold_left f (f accu a) l - -let rec fold_right f l accu = - match l with - [] -> accu - | a::l -> f a (fold_right f l accu) - -let rec map2 f l1 l2 = - match (l1, l2) with - ([], []) -> [] - | (a1::l1, a2::l2) -> let r = f a1 a2 in r :: map2 f l1 l2 - | (_, _) -> invalid_arg "List.map2" - -let rev_map2 f l1 l2 = - let rec rmap2_f accu l1 l2 = - match (l1, l2) with - | ([], []) -> accu - | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2 - | (_, _) -> invalid_arg "List.rev_map2" - in - rmap2_f [] l1 l2 - - -let rec iter2 f l1 l2 = - match (l1, l2) with - ([], []) -> () - | (a1::l1, a2::l2) -> f a1 a2; iter2 f l1 l2 - | (_, _) -> invalid_arg "List.iter2" - -let rec fold_left2 f accu l1 l2 = - match (l1, l2) with - ([], []) -> accu - | (a1::l1, a2::l2) -> fold_left2 f (f accu a1 a2) l1 l2 - | (_, _) -> invalid_arg "List.fold_left2" - -let rec fold_right2 f l1 l2 accu = - match (l1, l2) with - ([], []) -> accu - | (a1::l1, a2::l2) -> f a1 a2 (fold_right2 f l1 l2 accu) - | (_, _) -> invalid_arg "List.fold_right2" - -let rec for_all p = function - [] -> true - | a::l -> p a && for_all p l - -let rec exists p = function - [] -> false - | a::l -> p a || exists p l - -let rec for_all2 p l1 l2 = - match (l1, l2) with - ([], []) -> true - | (a1::l1, a2::l2) -> p a1 a2 && for_all2 p l1 l2 - | (_, _) -> invalid_arg "List.for_all2" - -let rec exists2 p l1 l2 = - match (l1, l2) with - ([], []) -> false - | (a1::l1, a2::l2) -> p a1 a2 || exists2 p l1 l2 - | (_, _) -> invalid_arg "List.exists2" - -let rec mem x = function - [] -> false - | a::l -> compare a x = 0 || mem x l - -let rec memq x = function - [] -> false - | a::l -> a == x || memq x l - -let rec assoc x = function - [] -> raise Not_found - | (a,b)::l -> if compare a x = 0 then b else assoc x l - -let rec assoc_opt x = function - [] -> None - | (a,b)::l -> if compare a x = 0 then Some b else assoc_opt x l - -let rec assq x = function - [] -> raise Not_found - | (a,b)::l -> if a == x then b else assq x l - -let rec assq_opt x = function - [] -> None - | (a,b)::l -> if a == x then Some b else assq_opt x l - -let rec mem_assoc x = function - | [] -> false - | (a, _) :: l -> compare a x = 0 || mem_assoc x l - -let rec mem_assq x = function - | [] -> false - | (a, _) :: l -> a == x || mem_assq x l - -let rec remove_assoc x = function - | [] -> [] - | (a, _ as pair) :: l -> - if compare a x = 0 then l else pair :: remove_assoc x l - -let rec remove_assq x = function - | [] -> [] - | (a, _ as pair) :: l -> if a == x then l else pair :: remove_assq x l - -let rec find p = function - | [] -> raise Not_found - | x :: l -> if p x then x else find p l - -let rec find_opt p = function - | [] -> None - | x :: l -> if p x then Some x else find_opt p l - -let find_all p = - let rec find accu = function - | [] -> rev accu - | x :: l -> if p x then find (x :: accu) l else find accu l in - find [] - -let filter = find_all - -let partition p l = - let rec part yes no = function - | [] -> (rev yes, rev no) - | x :: l -> if p x then part (x :: yes) no l else part yes (x :: no) l in - part [] [] l - -let rec split = function - [] -> ([], []) - | (x,y)::l -> - let (rx, ry) = split l in (x::rx, y::ry) - -let rec combine l1 l2 = - match (l1, l2) with - ([], []) -> [] - | (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2 - | (_, _) -> invalid_arg "List.combine" - -(** sorting *) - -let rec merge cmp l1 l2 = - match l1, l2 with - | [], l2 -> l2 - | l1, [] -> l1 - | h1 :: t1, h2 :: t2 -> - if cmp h1 h2 <= 0 - then h1 :: merge cmp t1 l2 - else h2 :: merge cmp l1 t2 - - -let rec chop k l = - if k = 0 then l else begin - match l with - | _::t -> chop (k-1) t - | _ -> assert false - end - - -let stable_sort cmp l = - let rec rev_merge l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - if cmp h1 h2 <= 0 - then rev_merge t1 l2 (h1::accu) - else rev_merge l1 t2 (h2::accu) - in - let rec rev_merge_rev l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - if cmp h1 h2 > 0 - then rev_merge_rev t1 l2 (h1::accu) - else rev_merge_rev l1 t2 (h2::accu) - in - let rec sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 <= 0 then begin - if cmp x2 x3 <= 0 then [x1; x2; x3] - else if cmp x1 x3 <= 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 <= 0 then [x2; x1; x3] - else if cmp x2 x3 <= 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] - and rev_sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 > 0 then begin - if cmp x2 x3 > 0 then [x1; x2; x3] - else if cmp x1 x3 > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 > 0 then [x2; x1; x3] - else if cmp x2 x3 > 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] - in - let len = length l in - if len < 2 then l else sort len l - - -let sort = stable_sort -let fast_sort = stable_sort - -(* Note: on a list of length between about 100000 (depending on the minor - heap size and the type of the list) and Sys.max_array_size, it is - actually faster to use the following, but it might also use more memory - because the argument list cannot be deallocated incrementally. - - Also, there seems to be a bug in this code or in the - implementation of obj_truncate. - -external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" - -let array_to_list_in_place a = - let l = Array.length a in - let rec loop accu n p = - if p <= 0 then accu else begin - if p = n then begin - obj_truncate a p; - loop (a.(p-1) :: accu) (n-1000) (p-1) - end else begin - loop (a.(p-1) :: accu) n (p-1) - end - end - in - loop [] (l-1000) l - - -let stable_sort cmp l = - let a = Array.of_list l in - Array.stable_sort cmp a; - array_to_list_in_place a - -*) - - -(** sorting + removing duplicates *) - -let sort_uniq cmp l = - let rec rev_merge l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - let c = cmp h1 h2 in - if c = 0 then rev_merge t1 t2 (h1::accu) - else if c < 0 - then rev_merge t1 l2 (h1::accu) - else rev_merge l1 t2 (h2::accu) - in - let rec rev_merge_rev l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - let c = cmp h1 h2 in - if c = 0 then rev_merge_rev t1 t2 (h1::accu) - else if c > 0 - then rev_merge_rev t1 l2 (h1::accu) - else rev_merge_rev l1 t2 (h2::accu) - in - let rec sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 in - if c = 0 then [x1] - else if c < 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 in - if c = 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x2] - else if c < 0 then [x2; x3] else [x3; x2] - end else if c < 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x2; x3] - else let c = cmp x1 x3 in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x1; x3] - else let c = cmp x2 x3 in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] - and rev_sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 in - if c = 0 then [x1] - else if c > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 in - if c = 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x2] - else if c > 0 then [x2; x3] else [x3; x2] - end else if c > 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x2; x3] - else let c = cmp x1 x3 in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x1; x3] - else let c = cmp x2 x3 in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] - in - let len = length l in - if len < 2 then l else sort len l - -let rec compare_lengths l1 l2 = - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | _ :: l1, _ :: l2 -> compare_lengths l1 l2 -;; - -let rec compare_length_with l n = - match l with - | [] -> - if n = 0 then 0 else - if n > 0 then -1 else 1 - | _ :: l -> - if n <= 0 then 1 else - compare_length_with l (n-1) -;; diff --git a/jscomp/stdlib-406/list.mli b/jscomp/stdlib-406/list.mli deleted file mode 100644 index cdcd23cdf6..0000000000 --- a/jscomp/stdlib-406/list.mli +++ /dev/null @@ -1,347 +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. *) -(* *) -(**************************************************************************) - -(** List operations. - - Some functions are flagged as not tail-recursive. A tail-recursive - function uses constant stack space, while a non-tail-recursive function - uses stack space proportional to the length of its list argument, which - can be a problem with very long lists. When the function takes several - list arguments, an approximate formula giving stack usage (in some - unspecified constant unit) is shown in parentheses. - - The above considerations can usually be ignored if your lists are not - longer than about 10000 elements. -*) - -val length : 'a list -> int -(** Return the length (number of elements) of the given list. *) - -val compare_lengths : 'a list -> 'b list -> int -(** Compare the lengths of two lists. [compare_lengths l1 l2] is - equivalent to [compare (length l1) (length l2)], except that - the computation stops after itering on the shortest list. - @since 4.05.0 - *) - -val compare_length_with : 'a list -> int -> int -(** Compare the length of a list to an integer. [compare_length_with l n] is - equivalent to [compare (length l) n], except that - the computation stops after at most [n] iterations on the list. - @since 4.05.0 -*) - -val cons : 'a -> 'a list -> 'a list -(** [cons x xs] is [x :: xs] - @since 4.03.0 -*) - -val hd : 'a list -> 'a -(** Return the first element of the given list. Raise - [Failure "hd"] if the list is empty. *) - -val tl : 'a list -> 'a list -(** Return the given list without its first element. Raise - [Failure "tl"] if the list is empty. *) - -val nth: 'a list -> int -> 'a -(** Return the [n]-th element of the given list. - The first element (head of the list) is at position 0. - Raise [Failure "nth"] if the list is too short. - Raise [Invalid_argument "List.nth"] if [n] is negative. *) - -val nth_opt: 'a list -> int -> 'a option -(** Return the [n]-th element of the given list. - The first element (head of the list) is at position 0. - Return [None] if the list is too short. - Raise [Invalid_argument "List.nth"] if [n] is negative. - @since 4.05 -*) - -val rev : 'a list -> 'a list -(** List reversal. *) - -val init : int -> (int -> 'a) -> 'a list -(** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. - - @raise Invalid_argument if len < 0. - @since 4.06.0 -*) - -val append : 'a list -> 'a list -> 'a list -(** Concatenate two lists. Same as the infix operator [@]. - Not tail-recursive (length of the first argument). *) - -val rev_append : 'a list -> 'a list -> 'a list -(** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. - This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is - tail-recursive and more efficient. *) - -val concat : 'a list list -> 'a list -(** Concatenate a list of lists. The elements of the argument are all - concatenated together (in the same order) to give the result. - Not tail-recursive - (length of the argument + length of the longest sub-list). *) - -val flatten : 'a list list -> 'a list -(** An alias for [concat]. *) - - -(** {1 Iterators} *) - - -val iter : ('a -> unit) -> 'a list -> unit -(** [List.iter f [a1; ...; an]] applies function [f] in turn to - [a1; ...; an]. It is equivalent to - [begin f a1; f a2; ...; f an; () end]. *) - -val iteri : (int -> 'a -> unit) -> 'a list -> unit -(** Same as {!List.iter}, but the function is applied to the index of - the element as first argument (counting from 0), and the element - itself as second argument. - @since 4.00.0 -*) - -val map : ('a -> 'b) -> 'a list -> 'b list -(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], - and builds the list [[f a1; ...; f an]] - with the results returned by [f]. Not tail-recursive. *) - -val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list -(** Same as {!List.map}, but the function is applied to the index of - the element as first argument (counting from 0), and the element - itself as second argument. Not tail-recursive. - @since 4.00.0 -*) - -val rev_map : ('a -> 'b) -> 'a list -> 'b list -(** [List.rev_map f l] gives the same result as - {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and - more efficient. *) - -val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a -(** [List.fold_left f a [b1; ...; bn]] is - [f (... (f (f a b1) b2) ...) bn]. *) - -val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b -(** [List.fold_right f [a1; ...; an] b] is - [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) - - -(** {1 Iterators on two lists} *) - - -val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit -(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn - [f a1 b1; ...; f an bn]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is - [[f a1 b1; ...; f an bn]]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. *) - -val rev_map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -(** [List.rev_map2 f l1 l2] gives the same result as - {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and - more efficient. *) - -val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a -(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is - [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> 'c -> 'c -(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is - [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. *) - - -(** {1 List scanning} *) - - -val for_all : ('a -> bool) -> 'a list -> bool -(** [for_all p [a1; ...; an]] checks if all elements of the list - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. *) - -val exists : ('a -> bool) -> 'a list -> bool -(** [exists p [a1; ...; an]] checks if at least one element of - the list satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. *) - -val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -(** Same as {!List.for_all}, but for a two-argument predicate. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool -(** Same as {!List.exists}, but for a two-argument predicate. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val mem : 'a -> 'a list -> bool -(** [mem a l] is true if and only if [a] is equal - to an element of [l]. *) - -val memq : 'a -> 'a list -> bool -(** Same as {!List.mem}, but uses physical equality instead of structural - equality to compare list elements. *) - - -(** {1 List searching} *) - - -val find : ('a -> bool) -> 'a list -> 'a -(** [find p l] returns the first element of the list [l] - that satisfies the predicate [p]. - Raise [Not_found] if there is no value that satisfies [p] in the - list [l]. *) - -val find_opt: ('a -> bool) -> 'a list -> 'a option -(** [find_opt p l] returns the first element of the list [l] that - satisfies the predicate [p], or [None] if there is no value that - satisfies [p] in the list [l]. - @since 4.05 *) - -val filter : ('a -> bool) -> 'a list -> 'a list -(** [filter p l] returns all the elements of the list [l] - that satisfy the predicate [p]. The order of the elements - in the input list is preserved. *) - -val find_all : ('a -> bool) -> 'a list -> 'a list -(** [find_all] is another name for {!List.filter}. *) - -val partition : ('a -> bool) -> 'a list -> 'a list * 'a list -(** [partition p l] returns a pair of lists [(l1, l2)], where - [l1] is the list of all the elements of [l] that - satisfy the predicate [p], and [l2] is the list of all the - elements of [l] that do not satisfy [p]. - The order of the elements in the input list is preserved. *) - - -(** {1 Association lists} *) - - -val assoc : 'a -> ('a * 'b) list -> 'b -(** [assoc a l] returns the value associated with key [a] in the list of - pairs [l]. That is, - [assoc a [ ...; (a,b); ...] = b] - if [(a,b)] is the leftmost binding of [a] in list [l]. - Raise [Not_found] if there is no value associated with [a] in the - list [l]. *) - -val assoc_opt: 'a -> ('a * 'b) list -> 'b option -(** [assoc_opt a l] returns the value associated with key [a] in the list of - pairs [l]. That is, - [assoc_opt a [ ...; (a,b); ...] = b] - if [(a,b)] is the leftmost binding of [a] in list [l]. - Returns [None] if there is no value associated with [a] in the - list [l]. - @since 4.05 *) - -val assq : 'a -> ('a * 'b) list -> 'b -(** Same as {!List.assoc}, but uses physical equality instead of structural - equality to compare keys. *) - -val assq_opt : 'a -> ('a * 'b) list -> 'b option -(** Same as {!List.assoc_opt}, but uses physical equality instead of structural - equality to compare keys. - @since 4.05 *) - -val mem_assoc : 'a -> ('a * 'b) list -> bool -(** Same as {!List.assoc}, but simply return true if a binding exists, - and false if no bindings exist for the given key. *) - -val mem_assq : 'a -> ('a * 'b) list -> bool -(** Same as {!List.mem_assoc}, but uses physical equality instead of - structural equality to compare keys. *) - -val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list -(** [remove_assoc a l] returns the list of - pairs [l] without the first pair with key [a], if any. - Not tail-recursive. *) - -val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list -(** Same as {!List.remove_assoc}, but uses physical equality instead - of structural equality to compare keys. Not tail-recursive. *) - - -(** {1 Lists of pairs} *) - - -val split : ('a * 'b) list -> 'a list * 'b list -(** Transform a list of pairs into a pair of lists: - [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. - Not tail-recursive. -*) - -val combine : 'a list -> 'b list -> ('a * 'b) list -(** Transform a pair of lists into a list of pairs: - [combine [a1; ...; an] [b1; ...; bn]] is - [[(a1,b1); ...; (an,bn)]]. - Raise [Invalid_argument] if the two lists - have different lengths. Not tail-recursive. *) - - -(** {1 Sorting} *) - - -val sort : ('a -> 'a -> int) -> 'a list -> 'a list -(** Sort a list in increasing order according to a comparison - function. The comparison function must return 0 if its arguments - compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller (see Array.sort for - a complete specification). For example, - {!Pervasives.compare} is a suitable comparison function. - The resulting list is sorted in increasing order. - [List.sort] is guaranteed to run in constant heap space - (in addition to the size of the result list) and logarithmic - stack space. - - The current implementation uses Merge Sort. It runs in constant - heap space and logarithmic stack space. -*) - -val stable_sort : ('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!List.sort}, but the sorting algorithm is guaranteed to - be stable (i.e. elements that compare equal are kept in their - original order) . - - The current implementation uses Merge Sort. It runs in constant - heap space and logarithmic stack space. -*) - -val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!List.sort} or {!List.stable_sort}, whichever is faster - on typical input. *) - -val sort_uniq : ('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!List.sort}, but also remove duplicates. - @since 4.02.0 *) - -val merge : ('a -> 'a -> int) -> 'a list -> 'a list -> 'a list -(** Merge two lists: - Assuming that [l1] and [l2] are sorted according to the - comparison function [cmp], [merge cmp l1 l2] will return a - sorted list containing all the elements of [l1] and [l2]. - If several elements compare equal, the elements of [l1] will be - before the elements of [l2]. - Not tail-recursive (sum of the lengths of the arguments). -*) diff --git a/jscomp/stdlib-406/list.res b/jscomp/stdlib-406/list.res new file mode 100644 index 0000000000..ae40d401cd --- /dev/null +++ b/jscomp/stdlib-406/list.res @@ -0,0 +1,751 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* List operations */ + +let rec length_aux = (len, param) => + switch param { + | list{} => len + | list{_, ...l} => length_aux(len + 1, l) + } + +let length = l => length_aux(0, l) + +let cons = (a, l) => list{a, ...l} + +let hd = param => + switch param { + | list{} => failwith("hd") + | list{a, ..._} => a + } + +let tl = param => + switch param { + | list{} => failwith("tl") + | list{_, ...l} => l + } + +let nth = (l, n) => + if n < 0 { + invalid_arg("List.nth") + } else { + let rec nth_aux = (l, n) => + switch l { + | list{} => failwith("nth") + | list{a, ...l} => + if n == 0 { + a + } else { + nth_aux(l, n - 1) + } + } + nth_aux(l, n) + } + +let nth_opt = (l, n) => + if n < 0 { + invalid_arg("List.nth") + } else { + let rec nth_aux = (l, n) => + switch l { + | list{} => None + | list{a, ...l} => + if n == 0 { + Some(a) + } else { + nth_aux(l, n - 1) + } + } + nth_aux(l, n) + } + +let append = \"@" + +let rec rev_append = (l1, l2) => + switch l1 { + | list{} => l2 + | list{a, ...l} => rev_append(l, list{a, ...l2}) + } + +let rev = l => rev_append(l, list{}) + +let rec init_tailrec_aux = (acc, i, n, f) => + if i >= n { + acc + } else { + init_tailrec_aux(list{f(i), ...acc}, i + 1, n, f) + } + +let rec init_aux = (i, n, f) => + if i >= n { + list{} + } else { + let r = f(i) + list{r, ...init_aux(i + 1, n, f)} + } + +let init = (len, f) => + if len < 0 { + invalid_arg("List.init") + } else if len > 10_000 { + rev(init_tailrec_aux(list{}, 0, len, f)) + } else { + init_aux(0, len, f) + } + +let rec flatten = param => + switch param { + | list{} => list{} + | list{l, ...r} => \"@"(l, flatten(r)) + } + +let concat = flatten + +let rec map = (f, param) => + switch param { + | list{} => list{} + | list{a, ...l} => + let r = f(a) + list{r, ...map(f, l)} + } + +let rec mapi = (i, f, param) => + switch param { + | list{} => list{} + | list{a, ...l} => + let r = f(i, a) + list{r, ...mapi(i + 1, f, l)} + } + +let mapi = (f, l) => mapi(0, f, l) + +let rev_map = (f, l) => { + let rec rmap_f = (accu, param) => + switch param { + | list{} => accu + | list{a, ...l} => rmap_f(list{f(a), ...accu}, l) + } + + rmap_f(list{}, l) +} + +let rec iter = (f, param) => + switch param { + | list{} => () + | list{a, ...l} => + f(a) + iter(f, l) + } + +let rec iteri = (i, f, param) => + switch param { + | list{} => () + | list{a, ...l} => + f(i, a) + iteri(i + 1, f, l) + } + +let iteri = (f, l) => iteri(0, f, l) + +let rec fold_left = (f, accu, l) => + switch l { + | list{} => accu + | list{a, ...l} => fold_left(f, f(accu, a), l) + } + +let rec fold_right = (f, l, accu) => + switch l { + | list{} => accu + | list{a, ...l} => f(a, fold_right(f, l, accu)) + } + +let rec map2 = (f, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => list{} + | (list{a1, ...l1}, list{a2, ...l2}) => + let r = f(a1, a2) + list{r, ...map2(f, l1, l2)} + | (_, _) => invalid_arg("List.map2") + } + +let rev_map2 = (f, l1, l2) => { + let rec rmap2_f = (accu, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => accu + | (list{a1, ...l1}, list{a2, ...l2}) => rmap2_f(list{f(a1, a2), ...accu}, l1, l2) + | (_, _) => invalid_arg("List.rev_map2") + } + + rmap2_f(list{}, l1, l2) +} + +let rec iter2 = (f, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => () + | (list{a1, ...l1}, list{a2, ...l2}) => + f(a1, a2) + iter2(f, l1, l2) + | (_, _) => invalid_arg("List.iter2") + } + +let rec fold_left2 = (f, accu, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => accu + | (list{a1, ...l1}, list{a2, ...l2}) => fold_left2(f, f(accu, a1, a2), l1, l2) + | (_, _) => invalid_arg("List.fold_left2") + } + +let rec fold_right2 = (f, l1, l2, accu) => + switch (l1, l2) { + | (list{}, list{}) => accu + | (list{a1, ...l1}, list{a2, ...l2}) => f(a1, a2, fold_right2(f, l1, l2, accu)) + | (_, _) => invalid_arg("List.fold_right2") + } + +let rec for_all = (p, param) => + switch param { + | list{} => true + | list{a, ...l} => p(a) && for_all(p, l) + } + +let rec exists = (p, param) => + switch param { + | list{} => false + | list{a, ...l} => p(a) || exists(p, l) + } + +let rec for_all2 = (p, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => true + | (list{a1, ...l1}, list{a2, ...l2}) => p(a1, a2) && for_all2(p, l1, l2) + | (_, _) => invalid_arg("List.for_all2") + } + +let rec exists2 = (p, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => false + | (list{a1, ...l1}, list{a2, ...l2}) => p(a1, a2) || exists2(p, l1, l2) + | (_, _) => invalid_arg("List.exists2") + } + +let rec mem = (x, param) => + switch param { + | list{} => false + | list{a, ...l} => compare(a, x) == 0 || mem(x, l) + } + +let rec memq = (x, param) => + switch param { + | list{} => false + | list{a, ...l} => a === x || memq(x, l) + } + +let rec assoc = (x, param) => + switch param { + | list{} => raise(Not_found) + | list{(a, b), ...l} => + if compare(a, x) == 0 { + b + } else { + assoc(x, l) + } + } + +let rec assoc_opt = (x, param) => + switch param { + | list{} => None + | list{(a, b), ...l} => + if compare(a, x) == 0 { + Some(b) + } else { + assoc_opt(x, l) + } + } + +let rec assq = (x, param) => + switch param { + | list{} => raise(Not_found) + | list{(a, b), ...l} => + if a === x { + b + } else { + assq(x, l) + } + } + +let rec assq_opt = (x, param) => + switch param { + | list{} => None + | list{(a, b), ...l} => + if a === x { + Some(b) + } else { + assq_opt(x, l) + } + } + +let rec mem_assoc = (x, param) => + switch param { + | list{} => false + | list{(a, _), ...l} => compare(a, x) == 0 || mem_assoc(x, l) + } + +let rec mem_assq = (x, param) => + switch param { + | list{} => false + | list{(a, _), ...l} => a === x || mem_assq(x, l) + } + +let rec remove_assoc = (x, param) => + switch param { + | list{} => list{} + | list{(a, _) as pair, ...l} => + if compare(a, x) == 0 { + l + } else { + list{pair, ...remove_assoc(x, l)} + } + } + +let rec remove_assq = (x, param) => + switch param { + | list{} => list{} + | list{(a, _) as pair, ...l} => + if a === x { + l + } else { + list{pair, ...remove_assq(x, l)} + } + } + +let rec find = (p, param) => + switch param { + | list{} => raise(Not_found) + | list{x, ...l} => + if p(x) { + x + } else { + find(p, l) + } + } + +let rec find_opt = (p, param) => + switch param { + | list{} => None + | list{x, ...l} => + if p(x) { + Some(x) + } else { + find_opt(p, l) + } + } + +let find_all = p => { + let rec find = (accu, param) => + switch param { + | list{} => rev(accu) + | list{x, ...l} => + if p(x) { + find(list{x, ...accu}, l) + } else { + find(accu, l) + } + } + find(list{}) +} + +let filter = find_all + +let partition = (p, l) => { + let rec part = (yes, no, param) => + switch param { + | list{} => (rev(yes), rev(no)) + | list{x, ...l} => + if p(x) { + part(list{x, ...yes}, no, l) + } else { + part(yes, list{x, ...no}, l) + } + } + part(list{}, list{}, l) +} + +let rec split = param => + switch param { + | list{} => (list{}, list{}) + | list{(x, y), ...l} => + let (rx, ry) = split(l) + (list{x, ...rx}, list{y, ...ry}) + } + +let rec combine = (l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => list{} + | (list{a1, ...l1}, list{a2, ...l2}) => list{(a1, a2), ...combine(l1, l2)} + | (_, _) => invalid_arg("List.combine") + } + +@@ocaml.text(" sorting ") + +let rec merge = (cmp, l1, l2) => + switch (l1, l2) { + | (list{}, l2) => l2 + | (l1, list{}) => l1 + | (list{h1, ...t1}, list{h2, ...t2}) => + if cmp(h1, h2) <= 0 { + list{h1, ...merge(cmp, t1, l2)} + } else { + list{h2, ...merge(cmp, l1, t2)} + } + } + +let rec chop = (k, l) => + if k == 0 { + l + } else { + switch l { + | list{_, ...t} => chop(k - 1, t) + | _ => assert(false) + } + } + +let stable_sort = (cmp, l) => { + let rec rev_merge = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + if cmp(h1, h2) <= 0 { + rev_merge(t1, l2, list{h1, ...accu}) + } else { + rev_merge(l1, t2, list{h2, ...accu}) + } + } + + let rec rev_merge_rev = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + if cmp(h1, h2) > 0 { + rev_merge_rev(t1, l2, list{h1, ...accu}) + } else { + rev_merge_rev(l1, t2, list{h2, ...accu}) + } + } + + let rec sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + if cmp(x1, x2) <= 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + if cmp(x1, x2) <= 0 { + if cmp(x2, x3) <= 0 { + list{x1, x2, x3} + } else if cmp(x1, x3) <= 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } else if cmp(x1, x3) <= 0 { + list{x2, x1, x3} + } else if cmp(x2, x3) <= 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = rev_sort(n1, l) + let s2 = rev_sort(n2, l2) + rev_merge_rev(s1, s2, list{}) + } + and rev_sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + if cmp(x1, x2) > 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + if cmp(x1, x2) > 0 { + if cmp(x2, x3) > 0 { + list{x1, x2, x3} + } else if cmp(x1, x3) > 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } else if cmp(x1, x3) > 0 { + list{x2, x1, x3} + } else if cmp(x2, x3) > 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = sort(n1, l) + let s2 = sort(n2, l2) + rev_merge(s1, s2, list{}) + } + + let len = length(l) + if len < 2 { + l + } else { + sort(len, l) + } +} + +let sort = stable_sort +let fast_sort = stable_sort + +@@ocaml.text( + /* Note: on a list of length between about 100000 (depending on the minor + heap size and the type of the list) and Sys.max_array_size, it is + actually faster to use the following, but it might also use more memory + because the argument list cannot be deallocated incrementally. + + Also, there seems to be a bug in this code or in the + implementation of obj_truncate. + +external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" + +let array_to_list_in_place a = + let l = Array.length a in + let rec loop accu n p = + if p <= 0 then accu else begin + if p = n then begin + obj_truncate a p; + loop (a.(p-1) :: accu) (n-1000) (p-1) + end else begin + loop (a.(p-1) :: accu) n (p-1) + end + end + in + loop [] (l-1000) l + + +let stable_sort cmp l = + let a = Array.of_list l in + Array.stable_sort cmp a; + array_to_list_in_place a + +*/ + + " sorting + removing duplicates " +) + +let sort_uniq = (cmp, l) => { + let rec rev_merge = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + let c = cmp(h1, h2) + if c == 0 { + rev_merge(t1, t2, list{h1, ...accu}) + } else if c < 0 { + rev_merge(t1, l2, list{h1, ...accu}) + } else { + rev_merge(l1, t2, list{h2, ...accu}) + } + } + + let rec rev_merge_rev = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + let c = cmp(h1, h2) + if c == 0 { + rev_merge_rev(t1, t2, list{h1, ...accu}) + } else if c > 0 { + rev_merge_rev(t1, l2, list{h1, ...accu}) + } else { + rev_merge_rev(l1, t2, list{h2, ...accu}) + } + } + + let rec sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + list{x1} + } else if c < 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x2} + } else if c < 0 { + list{x2, x3} + } else { + list{x3, x2} + } + } else if c < 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x1, x2} + } else if c < 0 { + list{x1, x2, x3} + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x1, x2} + } else if c < 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x2, x1} + } else if c < 0 { + list{x2, x1, x3} + } else { + let c = cmp(x2, x3) + if c == 0 { + list{x2, x1} + } else if c < 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + } + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = rev_sort(n1, l) + let s2 = rev_sort(n2, l2) + rev_merge_rev(s1, s2, list{}) + } + and rev_sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + list{x1} + } else if c > 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x2} + } else if c > 0 { + list{x2, x3} + } else { + list{x3, x2} + } + } else if c > 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x1, x2} + } else if c > 0 { + list{x1, x2, x3} + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x1, x2} + } else if c > 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x2, x1} + } else if c > 0 { + list{x2, x1, x3} + } else { + let c = cmp(x2, x3) + if c == 0 { + list{x2, x1} + } else if c > 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + } + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = sort(n1, l) + let s2 = sort(n2, l2) + rev_merge(s1, s2, list{}) + } + + let len = length(l) + if len < 2 { + l + } else { + sort(len, l) + } +} + +let rec compare_lengths = (l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => 0 + | (list{}, _) => -1 + | (_, list{}) => 1 + | (list{_, ...l1}, list{_, ...l2}) => compare_lengths(l1, l2) + } + +let rec compare_length_with = (l, n) => + switch l { + | list{} => + if n == 0 { + 0 + } else if n > 0 { + -1 + } else { + 1 + } + | list{_, ...l} => + if n <= 0 { + 1 + } else { + compare_length_with(l, n - 1) + } + } diff --git a/jscomp/stdlib-406/list.resi b/jscomp/stdlib-406/list.resi new file mode 100644 index 0000000000..8b04d7adb0 --- /dev/null +++ b/jscomp/stdlib-406/list.resi @@ -0,0 +1,333 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" List operations. + + Some functions are flagged as not tail-recursive. A tail-recursive + function uses constant stack space, while a non-tail-recursive function + uses stack space proportional to the length of its list argument, which + can be a problem with very long lists. When the function takes several + list arguments, an approximate formula giving stack usage (in some + unspecified constant unit) is shown in parentheses. + + The above considerations can usually be ignored if your lists are not + longer than about 10000 elements. +") + +@ocaml.doc(" Return the length (number of elements) of the given list. ") +let length: list<'a> => int + +@ocaml.doc(" Compare the lengths of two lists. [compare_lengths l1 l2] is + equivalent to [compare (length l1) (length l2)], except that + the computation stops after itering on the shortest list. + @since 4.05.0 + ") +let compare_lengths: (list<'a>, list<'b>) => int + +@ocaml.doc(" Compare the length of a list to an integer. [compare_length_with l n] is + equivalent to [compare (length l) n], except that + the computation stops after at most [n] iterations on the list. + @since 4.05.0 +") +let compare_length_with: (list<'a>, int) => int + +@ocaml.doc(" [cons x xs] is [x :: xs] + @since 4.03.0 +") +let cons: ('a, list<'a>) => list<'a> + +@ocaml.doc(" Return the first element of the given list. Raise + [Failure \"hd\"] if the list is empty. ") +let hd: list<'a> => 'a + +@ocaml.doc(" Return the given list without its first element. Raise + [Failure \"tl\"] if the list is empty. ") +let tl: list<'a> => list<'a> + +@ocaml.doc(" Return the [n]-th element of the given list. + The first element (head of the list) is at position 0. + Raise [Failure \"nth\"] if the list is too short. + Raise [Invalid_argument \"List.nth\"] if [n] is negative. ") +let nth: (list<'a>, int) => 'a + +@ocaml.doc(" Return the [n]-th element of the given list. + The first element (head of the list) is at position 0. + Return [None] if the list is too short. + Raise [Invalid_argument \"List.nth\"] if [n] is negative. + @since 4.05 +") +let nth_opt: (list<'a>, int) => option<'a> + +@ocaml.doc(" List reversal. ") +let rev: list<'a> => list<'a> + +@ocaml.doc(" [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. + + @raise Invalid_argument if len < 0. + @since 4.06.0 +") +let init: (int, int => 'a) => list<'a> + +@ocaml.doc(" Concatenate two lists. Same as the infix operator [@]. + Not tail-recursive (length of the first argument). ") +let append: (list<'a>, list<'a>) => list<'a> + +@ocaml.doc(" [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. + This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is + tail-recursive and more efficient. ") +let rev_append: (list<'a>, list<'a>) => list<'a> + +@ocaml.doc(" Concatenate a list of lists. The elements of the argument are all + concatenated together (in the same order) to give the result. + Not tail-recursive + (length of the argument + length of the longest sub-list). ") +let concat: list> => list<'a> + +@ocaml.doc(" An alias for [concat]. ") +let flatten: list> => list<'a> + +@@ocaml.text(" {1 Iterators} ") + +@ocaml.doc(" [List.iter f [a1; ...; an]] applies function [f] in turn to + [a1; ...; an]. It is equivalent to + [begin f a1; f a2; ...; f an; () end]. ") +let iter: ('a => unit, list<'a>) => unit + +@ocaml.doc(" Same as {!List.iter}, but the function is applied to the index of + the element as first argument (counting from 0), and the element + itself as second argument. + @since 4.00.0 +") +let iteri: ((int, 'a) => unit, list<'a>) => unit + +@ocaml.doc(" [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], + and builds the list [[f a1; ...; f an]] + with the results returned by [f]. Not tail-recursive. ") +let map: ('a => 'b, list<'a>) => list<'b> + +@ocaml.doc(" Same as {!List.map}, but the function is applied to the index of + the element as first argument (counting from 0), and the element + itself as second argument. Not tail-recursive. + @since 4.00.0 +") +let mapi: ((int, 'a) => 'b, list<'a>) => list<'b> + +@ocaml.doc(" [List.rev_map f l] gives the same result as + {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and + more efficient. ") +let rev_map: ('a => 'b, list<'a>) => list<'b> + +@ocaml.doc(" [List.fold_left f a [b1; ...; bn]] is + [f (... (f (f a b1) b2) ...) bn]. ") +let fold_left: (('a, 'b) => 'a, 'a, list<'b>) => 'a + +@ocaml.doc(" [List.fold_right f [a1; ...; an] b] is + [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. ") +let fold_right: (('a, 'b) => 'b, list<'a>, 'b) => 'b + +@@ocaml.text(" {1 Iterators on two lists} ") + +@ocaml.doc(" [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn + [f a1 b1; ...; f an bn]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let iter2: (('a, 'b) => unit, list<'a>, list<'b>) => unit + +@ocaml.doc(" [List.map2 f [a1; ...; an] [b1; ...; bn]] is + [[f a1 b1; ...; f an bn]]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. Not tail-recursive. ") +let map2: (('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> + +@ocaml.doc(" [List.rev_map2 f l1 l2] gives the same result as + {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and + more efficient. ") +let rev_map2: (('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> + +@ocaml.doc(" [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is + [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let fold_left2: (('a, 'b, 'c) => 'a, 'a, list<'b>, list<'c>) => 'a + +@ocaml.doc(" [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is + [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. Not tail-recursive. ") +let fold_right2: (('a, 'b, 'c) => 'c, list<'a>, list<'b>, 'c) => 'c + +@@ocaml.text(" {1 List scanning} ") + +@ocaml.doc(" [for_all p [a1; ...; an]] checks if all elements of the list + satisfy the predicate [p]. That is, it returns + [(p a1) && (p a2) && ... && (p an)]. ") +let for_all: ('a => bool, list<'a>) => bool + +@ocaml.doc(" [exists p [a1; ...; an]] checks if at least one element of + the list satisfies the predicate [p]. That is, it returns + [(p a1) || (p a2) || ... || (p an)]. ") +let exists: ('a => bool, list<'a>) => bool + +@ocaml.doc(" Same as {!List.for_all}, but for a two-argument predicate. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let for_all2: (('a, 'b) => bool, list<'a>, list<'b>) => bool + +@ocaml.doc(" Same as {!List.exists}, but for a two-argument predicate. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let exists2: (('a, 'b) => bool, list<'a>, list<'b>) => bool + +@ocaml.doc(" [mem a l] is true if and only if [a] is equal + to an element of [l]. ") +let mem: ('a, list<'a>) => bool + +@ocaml.doc(" Same as {!List.mem}, but uses physical equality instead of structural + equality to compare list elements. ") +let memq: ('a, list<'a>) => bool + +@@ocaml.text(" {1 List searching} ") + +@ocaml.doc(" [find p l] returns the first element of the list [l] + that satisfies the predicate [p]. + Raise [Not_found] if there is no value that satisfies [p] in the + list [l]. ") +let find: ('a => bool, list<'a>) => 'a + +@ocaml.doc(" [find_opt p l] returns the first element of the list [l] that + satisfies the predicate [p], or [None] if there is no value that + satisfies [p] in the list [l]. + @since 4.05 ") +let find_opt: ('a => bool, list<'a>) => option<'a> + +@ocaml.doc(" [filter p l] returns all the elements of the list [l] + that satisfy the predicate [p]. The order of the elements + in the input list is preserved. ") +let filter: ('a => bool, list<'a>) => list<'a> + +@ocaml.doc(" [find_all] is another name for {!List.filter}. ") +let find_all: ('a => bool, list<'a>) => list<'a> + +@ocaml.doc(" [partition p l] returns a pair of lists [(l1, l2)], where + [l1] is the list of all the elements of [l] that + satisfy the predicate [p], and [l2] is the list of all the + elements of [l] that do not satisfy [p]. + The order of the elements in the input list is preserved. ") +let partition: ('a => bool, list<'a>) => (list<'a>, list<'a>) + +@@ocaml.text(" {1 Association lists} ") + +@ocaml.doc(" [assoc a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Raise [Not_found] if there is no value associated with [a] in the + list [l]. ") +let assoc: ('a, list<('a, 'b)>) => 'b + +@ocaml.doc(" [assoc_opt a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc_opt a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Returns [None] if there is no value associated with [a] in the + list [l]. + @since 4.05 ") +let assoc_opt: ('a, list<('a, 'b)>) => option<'b> + +@ocaml.doc(" Same as {!List.assoc}, but uses physical equality instead of structural + equality to compare keys. ") +let assq: ('a, list<('a, 'b)>) => 'b + +@ocaml.doc(" Same as {!List.assoc_opt}, but uses physical equality instead of structural + equality to compare keys. + @since 4.05 ") +let assq_opt: ('a, list<('a, 'b)>) => option<'b> + +@ocaml.doc(" Same as {!List.assoc}, but simply return true if a binding exists, + and false if no bindings exist for the given key. ") +let mem_assoc: ('a, list<('a, 'b)>) => bool + +@ocaml.doc(" Same as {!List.mem_assoc}, but uses physical equality instead of + structural equality to compare keys. ") +let mem_assq: ('a, list<('a, 'b)>) => bool + +@ocaml.doc(" [remove_assoc a l] returns the list of + pairs [l] without the first pair with key [a], if any. + Not tail-recursive. ") +let remove_assoc: ('a, list<('a, 'b)>) => list<('a, 'b)> + +@ocaml.doc(" Same as {!List.remove_assoc}, but uses physical equality instead + of structural equality to compare keys. Not tail-recursive. ") +let remove_assq: ('a, list<('a, 'b)>) => list<('a, 'b)> + +@@ocaml.text(" {1 Lists of pairs} ") + +@ocaml.doc(" Transform a list of pairs into a pair of lists: + [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. + Not tail-recursive. +") +let split: list<('a, 'b)> => (list<'a>, list<'b>) + +@ocaml.doc(" Transform a pair of lists into a list of pairs: + [combine [a1; ...; an] [b1; ...; bn]] is + [[(a1,b1); ...; (an,bn)]]. + Raise [Invalid_argument] if the two lists + have different lengths. Not tail-recursive. ") +let combine: (list<'a>, list<'b>) => list<('a, 'b)> + +@@ocaml.text(" {1 Sorting} ") + +@ocaml.doc(" Sort a list in increasing order according to a comparison + function. The comparison function must return 0 if its arguments + compare as equal, a positive integer if the first is greater, + and a negative integer if the first is smaller (see Array.sort for + a complete specification). For example, + {!Pervasives.compare} is a suitable comparison function. + The resulting list is sorted in increasing order. + [List.sort] is guaranteed to run in constant heap space + (in addition to the size of the result list) and logarithmic + stack space. + + The current implementation uses Merge Sort. It runs in constant + heap space and logarithmic stack space. +") +let sort: (('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Same as {!List.sort}, but the sorting algorithm is guaranteed to + be stable (i.e. elements that compare equal are kept in their + original order) . + + The current implementation uses Merge Sort. It runs in constant + heap space and logarithmic stack space. +") +let stable_sort: (('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Same as {!List.sort} or {!List.stable_sort}, whichever is faster + on typical input. ") +let fast_sort: (('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Same as {!List.sort}, but also remove duplicates. + @since 4.02.0 ") +let sort_uniq: (('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Merge two lists: + Assuming that [l1] and [l2] are sorted according to the + comparison function [cmp], [merge cmp l1 l2] will return a + sorted list containing all the elements of [l1] and [l2]. + If several elements compare equal, the elements of [l1] will be + before the elements of [l2]. + Not tail-recursive (sum of the lengths of the arguments). +") +let merge: (('a, 'a) => int, list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/listLabels.ml b/jscomp/stdlib-406/listLabels.ml deleted file mode 100644 index 96a55ae03c..0000000000 --- a/jscomp/stdlib-406/listLabels.ml +++ /dev/null @@ -1,485 +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. *) -(* *) -(**************************************************************************) - -(* List operations *) - -let rec length_aux len = function - [] -> len - | _::l -> length_aux (len + 1) l - -let length l = length_aux 0 l - -let cons a l = a::l - -let hd = function - [] -> failwith "hd" - | a::_ -> a - -let tl = function - [] -> failwith "tl" - | _::l -> l - -let nth l n = - if n < 0 then invalid_arg "List.nth" else - let rec nth_aux l n = - match l with - | [] -> failwith "nth" - | a::l -> if n = 0 then a else nth_aux l (n-1) - in nth_aux l n - -let nth_opt l n = - if n < 0 then invalid_arg "List.nth" else - let rec nth_aux l n = - match l with - | [] -> None - | a::l -> if n = 0 then Some a else nth_aux l (n-1) - in nth_aux l n - -let append = (@) - -let rec rev_append l1 l2 = - match l1 with - [] -> l2 - | a :: l -> rev_append l (a :: l2) - -let rev l = rev_append l [] - -let rec init_tailrec_aux acc i n f = - if i >= n then acc - else init_tailrec_aux (f i :: acc) (i+1) n f - -let rec init_aux i n f = - if i >= n then [] - else - let r = f i in - r :: init_aux (i+1) n f - -let init ~len ~f = - if len < 0 then invalid_arg "List.init" else - if len > 10_000 then rev (init_tailrec_aux [] 0 len f) - else init_aux 0 len f - -let rec flatten = function - [] -> [] - | l::r -> l @ flatten r - -let concat = flatten - -let rec map ~f = function - [] -> [] - | a::l -> let r = f a in r :: map ~f l - -let rec mapi i f = function - [] -> [] - | a::l -> let r = f i a in r :: mapi (i + 1) f l - -let mapi ~f l = mapi 0 f l - -let rev_map ~f l = - let rec rmap_f accu = function - | [] -> accu - | a::l -> rmap_f (f a :: accu) l - in - rmap_f [] l - - -let rec iter ~f = function - [] -> () - | a::l -> f a; iter ~f l - -let rec iteri i f = function - [] -> () - | a::l -> f i a; iteri (i + 1) f l - -let iteri ~f l = iteri 0 f l - -let rec fold_left ~f ~init:accu l = - match l with - [] -> accu - | a::l -> fold_left ~f ~init:(f accu a) l - -let rec fold_right ~f l ~init:accu = - match l with - [] -> accu - | a::l -> f a (fold_right ~f l ~init:accu) - -let rec map2 ~f l1 l2 = - match (l1, l2) with - ([], []) -> [] - | (a1::l1, a2::l2) -> let r = f a1 a2 in r :: map2 ~f l1 l2 - | (_, _) -> invalid_arg "List.map2" - -let rev_map2 ~f l1 l2 = - let rec rmap2_f accu l1 l2 = - match (l1, l2) with - | ([], []) -> accu - | (a1::l1, a2::l2) -> rmap2_f (f a1 a2 :: accu) l1 l2 - | (_, _) -> invalid_arg "List.rev_map2" - in - rmap2_f [] l1 l2 - - -let rec iter2 ~f l1 l2 = - match (l1, l2) with - ([], []) -> () - | (a1::l1, a2::l2) -> f a1 a2; iter2 ~f l1 l2 - | (_, _) -> invalid_arg "List.iter2" - -let rec fold_left2 ~f ~init:accu l1 l2 = - match (l1, l2) with - ([], []) -> accu - | (a1::l1, a2::l2) -> fold_left2 ~f ~init:(f accu a1 a2) l1 l2 - | (_, _) -> invalid_arg "List.fold_left2" - -let rec fold_right2 ~f l1 l2 ~init:accu = - match (l1, l2) with - ([], []) -> accu - | (a1::l1, a2::l2) -> f a1 a2 (fold_right2 ~f l1 l2 ~init:accu) - | (_, _) -> invalid_arg "List.fold_right2" - -let rec for_all ~f:p = function - [] -> true - | a::l -> p a && for_all ~f:p l - -let rec exists ~f:p = function - [] -> false - | a::l -> p a || exists ~f:p l - -let rec for_all2 ~f:p l1 l2 = - match (l1, l2) with - ([], []) -> true - | (a1::l1, a2::l2) -> p a1 a2 && for_all2 ~f:p l1 l2 - | (_, _) -> invalid_arg "List.for_all2" - -let rec exists2 ~f:p l1 l2 = - match (l1, l2) with - ([], []) -> false - | (a1::l1, a2::l2) -> p a1 a2 || exists2 ~f:p l1 l2 - | (_, _) -> invalid_arg "List.exists2" - -let rec mem x ~set = match set with - [] -> false - | a::l -> compare a x = 0 || mem x ~set:l - -let rec memq x ~set = match set with - [] -> false - | a::l -> a == x || memq x ~set:l - -let rec assoc x = function - [] -> raise Not_found - | (a,b)::l -> if compare a x = 0 then b else assoc x l - -let rec assoc_opt x = function - [] -> None - | (a,b)::l -> if compare a x = 0 then Some b else assoc_opt x l - -let rec assq x = function - [] -> raise Not_found - | (a,b)::l -> if a == x then b else assq x l - -let rec assq_opt x = function - [] -> None - | (a,b)::l -> if a == x then Some b else assq_opt x l - -let rec mem_assoc x ~map = match map with - | [] -> false - | (a, _) :: l -> compare a x = 0 || mem_assoc x ~map:l - -let rec mem_assq x ~map = match map with - | [] -> false - | (a, _) :: l -> a == x || mem_assq x ~map:l - -let rec remove_assoc x = function - | [] -> [] - | (a, _ as pair) :: l -> - if compare a x = 0 then l else pair :: remove_assoc x l - -let rec remove_assq x = function - | [] -> [] - | (a, _ as pair) :: l -> if a == x then l else pair :: remove_assq x l - -let rec find ~f:p = function - | [] -> raise Not_found - | x :: l -> if p x then x else find ~f:p l - -let rec find_opt ~f:p = function - | [] -> None - | x :: l -> if p x then Some x else find_opt ~f:p l - -let find_all ~f:p = - let rec find accu = function - | [] -> rev accu - | x :: l -> if p x then find (x :: accu) l else find accu l in - find [] - -let filter = find_all - -let partition ~f:p l = - let rec part yes no = function - | [] -> (rev yes, rev no) - | x :: l -> if p x then part (x :: yes) no l else part yes (x :: no) l in - part [] [] l - -let rec split = function - [] -> ([], []) - | (x,y)::l -> - let (rx, ry) = split l in (x::rx, y::ry) - -let rec combine l1 l2 = - match (l1, l2) with - ([], []) -> [] - | (a1::l1, a2::l2) -> (a1, a2) :: combine l1 l2 - | (_, _) -> invalid_arg "List.combine" - -(** sorting *) - -let rec merge ~cmp l1 l2 = - match l1, l2 with - | [], l2 -> l2 - | l1, [] -> l1 - | h1 :: t1, h2 :: t2 -> - if cmp h1 h2 <= 0 - then h1 :: merge ~cmp t1 l2 - else h2 :: merge ~cmp l1 t2 - - -let rec chop k l = - if k = 0 then l else begin - match l with - | _::t -> chop (k-1) t - | _ -> assert false - end - - -let stable_sort ~cmp l = - let rec rev_merge l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - if cmp h1 h2 <= 0 - then rev_merge t1 l2 (h1::accu) - else rev_merge l1 t2 (h2::accu) - in - let rec rev_merge_rev l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - if cmp h1 h2 > 0 - then rev_merge_rev t1 l2 (h1::accu) - else rev_merge_rev l1 t2 (h2::accu) - in - let rec sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 <= 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 <= 0 then begin - if cmp x2 x3 <= 0 then [x1; x2; x3] - else if cmp x1 x3 <= 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 <= 0 then [x2; x1; x3] - else if cmp x2 x3 <= 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] - and rev_sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - if cmp x1 x2 > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - if cmp x1 x2 > 0 then begin - if cmp x2 x3 > 0 then [x1; x2; x3] - else if cmp x1 x3 > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - if cmp x1 x3 > 0 then [x2; x1; x3] - else if cmp x2 x3 > 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] - in - let len = length l in - if len < 2 then l else sort len l - - -let sort = stable_sort -let fast_sort = stable_sort - -(* Note: on a list of length between about 100000 (depending on the minor - heap size and the type of the list) and Sys.max_array_size, it is - actually faster to use the following, but it might also use more memory - because the argument list cannot be deallocated incrementally. - - Also, there seems to be a bug in this code or in the - implementation of obj_truncate. - -external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" - -let array_to_list_in_place a = - let l = Array.length a in - let rec loop accu n p = - if p <= 0 then accu else begin - if p = n then begin - obj_truncate a p; - loop (a.(p-1) :: accu) (n-1000) (p-1) - end else begin - loop (a.(p-1) :: accu) n (p-1) - end - end - in - loop [] (l-1000) l - - -let stable_sort cmp l = - let a = Array.of_list l in - Array.stable_sort cmp a; - array_to_list_in_place a - -*) - - -(** sorting + removing duplicates *) - -let sort_uniq ~cmp l = - let rec rev_merge l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - let c = cmp h1 h2 in - if c = 0 then rev_merge t1 t2 (h1::accu) - else if c < 0 - then rev_merge t1 l2 (h1::accu) - else rev_merge l1 t2 (h2::accu) - in - let rec rev_merge_rev l1 l2 accu = - match l1, l2 with - | [], l2 -> rev_append l2 accu - | l1, [] -> rev_append l1 accu - | h1::t1, h2::t2 -> - let c = cmp h1 h2 in - if c = 0 then rev_merge_rev t1 t2 (h1::accu) - else if c > 0 - then rev_merge_rev t1 l2 (h1::accu) - else rev_merge_rev l1 t2 (h2::accu) - in - let rec sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 in - if c = 0 then [x1] - else if c < 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 in - if c = 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x2] - else if c < 0 then [x2; x3] else [x3; x2] - end else if c < 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x2; x3] - else let c = cmp x1 x3 in - if c = 0 then [x1; x2] - else if c < 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x1; x3] - else let c = cmp x2 x3 in - if c = 0 then [x2; x1] - else if c < 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = rev_sort n1 l in - let s2 = rev_sort n2 l2 in - rev_merge_rev s1 s2 [] - and rev_sort n l = - match n, l with - | 2, x1 :: x2 :: _ -> - let c = cmp x1 x2 in - if c = 0 then [x1] - else if c > 0 then [x1; x2] else [x2; x1] - | 3, x1 :: x2 :: x3 :: _ -> - let c = cmp x1 x2 in - if c = 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x2] - else if c > 0 then [x2; x3] else [x3; x2] - end else if c > 0 then begin - let c = cmp x2 x3 in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x2; x3] - else let c = cmp x1 x3 in - if c = 0 then [x1; x2] - else if c > 0 then [x1; x3; x2] - else [x3; x1; x2] - end else begin - let c = cmp x1 x3 in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x1; x3] - else let c = cmp x2 x3 in - if c = 0 then [x2; x1] - else if c > 0 then [x2; x3; x1] - else [x3; x2; x1] - end - | n, l -> - let n1 = n asr 1 in - let n2 = n - n1 in - let l2 = chop n1 l in - let s1 = sort n1 l in - let s2 = sort n2 l2 in - rev_merge s1 s2 [] - in - let len = length l in - if len < 2 then l else sort len l - -let rec compare_lengths l1 l2 = - match l1, l2 with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | _ :: l1, _ :: l2 -> compare_lengths l1 l2 -;; - -let rec compare_length_with l ~len:n = - match l with - | [] -> - if n = 0 then 0 else - if n > 0 then -1 else 1 - | _ :: l -> - if n <= 0 then 1 else - compare_length_with l ~len:(n-1) -;; diff --git a/jscomp/stdlib-406/listLabels.mli b/jscomp/stdlib-406/listLabels.mli deleted file mode 100644 index d5d9cd400e..0000000000 --- a/jscomp/stdlib-406/listLabels.mli +++ /dev/null @@ -1,353 +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. *) -(* *) -(**************************************************************************) - -(** List operations. - - Some functions are flagged as not tail-recursive. A tail-recursive - function uses constant stack space, while a non-tail-recursive function - uses stack space proportional to the length of its list argument, which - can be a problem with very long lists. When the function takes several - list arguments, an approximate formula giving stack usage (in some - unspecified constant unit) is shown in parentheses. - - The above considerations can usually be ignored if your lists are not - longer than about 10000 elements. -*) - -val length : 'a list -> int -(** Return the length (number of elements) of the given list. *) - -val hd : 'a list -> 'a -(** Return the first element of the given list. Raise - [Failure "hd"] if the list is empty. *) - -val compare_lengths : 'a list -> 'b list -> int -(** Compare the lengths of two lists. [compare_lengths l1 l2] is - equivalent to [compare (length l1) (length l2)], except that - the computation stops after itering on the shortest list. - @since 4.05.0 - *) - -val compare_length_with : 'a list -> len:int -> int -(** Compare the length of a list to an integer. [compare_length_with l n] is - equivalent to [compare (length l) n], except that - the computation stops after at most [n] iterations on the list. - @since 4.05.0 -*) - -val cons : 'a -> 'a list -> 'a list -(** [cons x xs] is [x :: xs] - @since 4.05.0 -*) - -val tl : 'a list -> 'a list -(** Return the given list without its first element. Raise - [Failure "tl"] if the list is empty. *) - -val nth : 'a list -> int -> 'a -(** Return the [n]-th element of the given list. - The first element (head of the list) is at position 0. - Raise [Failure "nth"] if the list is too short. - Raise [Invalid_argument "List.nth"] if [n] is negative. *) - -val nth_opt: 'a list -> int -> 'a option -(** Return the [n]-th element of the given list. - The first element (head of the list) is at position 0. - Return [None] if the list is too short. - Raise [Invalid_argument "List.nth"] if [n] is negative. - @since 4.05 -*) - -val rev : 'a list -> 'a list -(** List reversal. *) - -val init : len:int -> f:(int -> 'a) -> 'a list -(** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. - - @raise Invalid_argument if [len < 0]. - @since 4.06.0 -*) - -val append : 'a list -> 'a list -> 'a list -(** Catenate two lists. Same function as the infix operator [@]. - Not tail-recursive (length of the first argument). The [@] - operator is not tail-recursive either. *) - -val rev_append : 'a list -> 'a list -> 'a list -(** [List.rev_append l1 l2] reverses [l1] and concatenates it with [l2]. - This is equivalent to [(]{!List.rev}[ l1) @ l2], but [rev_append] is - tail-recursive and more efficient. *) - -val concat : 'a list list -> 'a list -(** Concatenate a list of lists. The elements of the argument are all - concatenated together (in the same order) to give the result. - Not tail-recursive - (length of the argument + length of the longest sub-list). *) - -val flatten : 'a list list -> 'a list -(** Same as [concat]. Not tail-recursive - (length of the argument + length of the longest sub-list). *) - - -(** {1 Iterators} *) - - -val iter : f:('a -> unit) -> 'a list -> unit -(** [List.iter f [a1; ...; an]] applies function [f] in turn to - [a1; ...; an]. It is equivalent to - [begin f a1; f a2; ...; f an; () end]. *) - -val iteri : f:(int -> 'a -> unit) -> 'a list -> unit -(** Same as {!List.iter}, but the function is applied to the index of - the element as first argument (counting from 0), and the element - itself as second argument. - @since 4.00.0 -*) - -val map : f:('a -> 'b) -> 'a list -> 'b list -(** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], - and builds the list [[f a1; ...; f an]] - with the results returned by [f]. Not tail-recursive. *) - -val mapi : f:(int -> 'a -> 'b) -> 'a list -> 'b list -(** Same as {!List.map}, but the function is applied to the index of - the element as first argument (counting from 0), and the element - itself as second argument. - @since 4.00.0 -*) - -val rev_map : f:('a -> 'b) -> 'a list -> 'b list -(** [List.rev_map f l] gives the same result as - {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and - more efficient. *) - -val fold_left : f:('a -> 'b -> 'a) -> init:'a -> 'b list -> 'a -(** [List.fold_left f a [b1; ...; bn]] is - [f (... (f (f a b1) b2) ...) bn]. *) - -val fold_right : f:('a -> 'b -> 'b) -> 'a list -> init:'b -> 'b -(** [List.fold_right f [a1; ...; an] b] is - [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. *) - - -(** {1 Iterators on two lists} *) - - -val iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit -(** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn - [f a1 b1; ...; f an bn]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -(** [List.map2 f [a1; ...; an] [b1; ...; bn]] is - [[f a1 b1; ...; f an bn]]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. *) - -val rev_map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list -(** [List.rev_map2 f l1 l2] gives the same result as - {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and - more efficient. *) - -val fold_left2 : - f:('a -> 'b -> 'c -> 'a) -> init:'a -> 'b list -> 'c list -> 'a -(** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is - [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val fold_right2 : - f:('a -> 'b -> 'c -> 'c) -> 'a list -> 'b list -> init:'c -> 'c -(** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is - [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. *) - - -(** {1 List scanning} *) - - -val for_all : f:('a -> bool) -> 'a list -> bool -(** [for_all p [a1; ...; an]] checks if all elements of the list - satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. *) - -val exists : f:('a -> bool) -> 'a list -> bool -(** [exists p [a1; ...; an]] checks if at least one element of - the list satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. *) - -val for_all2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool -(** Same as {!List.for_all}, but for a two-argument predicate. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val exists2 : f:('a -> 'b -> bool) -> 'a list -> 'b list -> bool -(** Same as {!List.exists}, but for a two-argument predicate. - Raise [Invalid_argument] if the two lists are determined - to have different lengths. *) - -val mem : 'a -> set:'a list -> bool -(** [mem a l] is true if and only if [a] is equal - to an element of [l]. *) - -val memq : 'a -> set:'a list -> bool -(** Same as {!List.mem}, but uses physical equality instead of structural - equality to compare list elements. *) - - -(** {1 List searching} *) - - -val find : f:('a -> bool) -> 'a list -> 'a -(** [find p l] returns the first element of the list [l] - that satisfies the predicate [p]. - Raise [Not_found] if there is no value that satisfies [p] in the - list [l]. *) - -val find_opt: f:('a -> bool) -> 'a list -> 'a option -(** [find p l] returns the first element of the list [l] - that satisfies the predicate [p]. - Returns [None] if there is no value that satisfies [p] in the - list [l]. - @since 4.05 *) - -val filter : f:('a -> bool) -> 'a list -> 'a list -(** [filter p l] returns all the elements of the list [l] - that satisfy the predicate [p]. The order of the elements - in the input list is preserved. *) - -val find_all : f:('a -> bool) -> 'a list -> 'a list -(** [find_all] is another name for {!List.filter}. *) - -val partition : f:('a -> bool) -> 'a list -> 'a list * 'a list -(** [partition p l] returns a pair of lists [(l1, l2)], where - [l1] is the list of all the elements of [l] that - satisfy the predicate [p], and [l2] is the list of all the - elements of [l] that do not satisfy [p]. - The order of the elements in the input list is preserved. *) - - -(** {1 Association lists} *) - - -val assoc : 'a -> ('a * 'b) list -> 'b -(** [assoc a l] returns the value associated with key [a] in the list of - pairs [l]. That is, - [assoc a [ ...; (a,b); ...] = b] - if [(a,b)] is the leftmost binding of [a] in list [l]. - Raise [Not_found] if there is no value associated with [a] in the - list [l]. *) - -val assoc_opt: 'a -> ('a * 'b) list -> 'b option -(** [assoc_opt a l] returns the value associated with key [a] in the list of - pairs [l]. That is, - [assoc a [ ...; (a,b); ...] = b] - if [(a,b)] is the leftmost binding of [a] in list [l]. - Returns [None] if there is no value associated with [a] in the - list [l]. - @since 4.05 -*) - -val assq : 'a -> ('a * 'b) list -> 'b -(** Same as {!List.assoc}, but uses physical equality instead of - structural equality to compare keys. *) - -val assq_opt: 'a -> ('a * 'b) list -> 'b option -(** Same as {!List.assoc_opt}, but uses physical equality instead of - structural equality to compare keys. - @since 4.05.0 *) - -val mem_assoc : 'a -> map:('a * 'b) list -> bool -(** Same as {!List.assoc}, but simply return true if a binding exists, - and false if no bindings exist for the given key. *) - -val mem_assq : 'a -> map:('a * 'b) list -> bool -(** Same as {!List.mem_assoc}, but uses physical equality instead of - structural equality to compare keys. *) - -val remove_assoc : 'a -> ('a * 'b) list -> ('a * 'b) list -(** [remove_assoc a l] returns the list of - pairs [l] without the first pair with key [a], if any. - Not tail-recursive. *) - -val remove_assq : 'a -> ('a * 'b) list -> ('a * 'b) list -(** Same as {!List.remove_assoc}, but uses physical equality instead - of structural equality to compare keys. Not tail-recursive. *) - - -(** {1 Lists of pairs} *) - - -val split : ('a * 'b) list -> 'a list * 'b list -(** Transform a list of pairs into a pair of lists: - [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. - Not tail-recursive. -*) - -val combine : 'a list -> 'b list -> ('a * 'b) list -(** Transform a pair of lists into a list of pairs: - [combine [a1; ...; an] [b1; ...; bn]] is - [[(a1,b1); ...; (an,bn)]]. - Raise [Invalid_argument] if the two lists - have different lengths. Not tail-recursive. *) - - -(** {1 Sorting} *) - - -val sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Sort a list in increasing order according to a comparison - function. The comparison function must return 0 if its arguments - compare as equal, a positive integer if the first is greater, - and a negative integer if the first is smaller (see Array.sort for - a complete specification). For example, - {!Pervasives.compare} is a suitable comparison function. - The resulting list is sorted in increasing order. - [List.sort] is guaranteed to run in constant heap space - (in addition to the size of the result list) and logarithmic - stack space. - - The current implementation uses Merge Sort. It runs in constant - heap space and logarithmic stack space. -*) - -val stable_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!List.sort}, but the sorting algorithm is guaranteed to - be stable (i.e. elements that compare equal are kept in their - original order) . - - The current implementation uses Merge Sort. It runs in constant - heap space and logarithmic stack space. -*) - -val fast_sort : cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!List.sort} or {!List.stable_sort}, whichever is - faster on typical input. *) - -val sort_uniq : cmp:('a -> 'a -> int) -> 'a list -> 'a list -(** Same as {!List.sort}, but also remove duplicates. - @since 4.03.0 *) - -val merge : cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list -(** Merge two lists: - Assuming that [l1] and [l2] are sorted according to the - comparison function [cmp], [merge cmp l1 l2] will return a - sorted list containing all the elements of [l1] and [l2]. - If several elements compare equal, the elements of [l1] will be - before the elements of [l2]. - Not tail-recursive (sum of the lengths of the arguments). -*) diff --git a/jscomp/stdlib-406/listLabels.res b/jscomp/stdlib-406/listLabels.res new file mode 100644 index 0000000000..969cfd107c --- /dev/null +++ b/jscomp/stdlib-406/listLabels.res @@ -0,0 +1,751 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* List operations */ + +let rec length_aux = (len, param) => + switch param { + | list{} => len + | list{_, ...l} => length_aux(len + 1, l) + } + +let length = l => length_aux(0, l) + +let cons = (a, l) => list{a, ...l} + +let hd = param => + switch param { + | list{} => failwith("hd") + | list{a, ..._} => a + } + +let tl = param => + switch param { + | list{} => failwith("tl") + | list{_, ...l} => l + } + +let nth = (l, n) => + if n < 0 { + invalid_arg("List.nth") + } else { + let rec nth_aux = (l, n) => + switch l { + | list{} => failwith("nth") + | list{a, ...l} => + if n == 0 { + a + } else { + nth_aux(l, n - 1) + } + } + nth_aux(l, n) + } + +let nth_opt = (l, n) => + if n < 0 { + invalid_arg("List.nth") + } else { + let rec nth_aux = (l, n) => + switch l { + | list{} => None + | list{a, ...l} => + if n == 0 { + Some(a) + } else { + nth_aux(l, n - 1) + } + } + nth_aux(l, n) + } + +let append = \"@" + +let rec rev_append = (l1, l2) => + switch l1 { + | list{} => l2 + | list{a, ...l} => rev_append(l, list{a, ...l2}) + } + +let rev = l => rev_append(l, list{}) + +let rec init_tailrec_aux = (acc, i, n, f) => + if i >= n { + acc + } else { + init_tailrec_aux(list{f(i), ...acc}, i + 1, n, f) + } + +let rec init_aux = (i, n, f) => + if i >= n { + list{} + } else { + let r = f(i) + list{r, ...init_aux(i + 1, n, f)} + } + +let init = (~len, ~f) => + if len < 0 { + invalid_arg("List.init") + } else if len > 10_000 { + rev(init_tailrec_aux(list{}, 0, len, f)) + } else { + init_aux(0, len, f) + } + +let rec flatten = param => + switch param { + | list{} => list{} + | list{l, ...r} => \"@"(l, flatten(r)) + } + +let concat = flatten + +let rec map = (~f, param) => + switch param { + | list{} => list{} + | list{a, ...l} => + let r = f(a) + list{r, ...map(~f, l)} + } + +let rec mapi = (i, f, param) => + switch param { + | list{} => list{} + | list{a, ...l} => + let r = f(i, a) + list{r, ...mapi(i + 1, f, l)} + } + +let mapi = (~f, l) => mapi(0, f, l) + +let rev_map = (~f, l) => { + let rec rmap_f = (accu, param) => + switch param { + | list{} => accu + | list{a, ...l} => rmap_f(list{f(a), ...accu}, l) + } + + rmap_f(list{}, l) +} + +let rec iter = (~f, param) => + switch param { + | list{} => () + | list{a, ...l} => + f(a) + iter(~f, l) + } + +let rec iteri = (i, f, param) => + switch param { + | list{} => () + | list{a, ...l} => + f(i, a) + iteri(i + 1, f, l) + } + +let iteri = (~f, l) => iteri(0, f, l) + +let rec fold_left = (~f, ~init as accu, l) => + switch l { + | list{} => accu + | list{a, ...l} => fold_left(~f, ~init=f(accu, a), l) + } + +let rec fold_right = (~f, l, ~init as accu) => + switch l { + | list{} => accu + | list{a, ...l} => f(a, fold_right(~f, l, ~init=accu)) + } + +let rec map2 = (~f, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => list{} + | (list{a1, ...l1}, list{a2, ...l2}) => + let r = f(a1, a2) + list{r, ...map2(~f, l1, l2)} + | (_, _) => invalid_arg("List.map2") + } + +let rev_map2 = (~f, l1, l2) => { + let rec rmap2_f = (accu, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => accu + | (list{a1, ...l1}, list{a2, ...l2}) => rmap2_f(list{f(a1, a2), ...accu}, l1, l2) + | (_, _) => invalid_arg("List.rev_map2") + } + + rmap2_f(list{}, l1, l2) +} + +let rec iter2 = (~f, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => () + | (list{a1, ...l1}, list{a2, ...l2}) => + f(a1, a2) + iter2(~f, l1, l2) + | (_, _) => invalid_arg("List.iter2") + } + +let rec fold_left2 = (~f, ~init as accu, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => accu + | (list{a1, ...l1}, list{a2, ...l2}) => fold_left2(~f, ~init=f(accu, a1, a2), l1, l2) + | (_, _) => invalid_arg("List.fold_left2") + } + +let rec fold_right2 = (~f, l1, l2, ~init as accu) => + switch (l1, l2) { + | (list{}, list{}) => accu + | (list{a1, ...l1}, list{a2, ...l2}) => f(a1, a2, fold_right2(~f, l1, l2, ~init=accu)) + | (_, _) => invalid_arg("List.fold_right2") + } + +let rec for_all = (~f as p, param) => + switch param { + | list{} => true + | list{a, ...l} => p(a) && for_all(~f=p, l) + } + +let rec exists = (~f as p, param) => + switch param { + | list{} => false + | list{a, ...l} => p(a) || exists(~f=p, l) + } + +let rec for_all2 = (~f as p, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => true + | (list{a1, ...l1}, list{a2, ...l2}) => p(a1, a2) && for_all2(~f=p, l1, l2) + | (_, _) => invalid_arg("List.for_all2") + } + +let rec exists2 = (~f as p, l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => false + | (list{a1, ...l1}, list{a2, ...l2}) => p(a1, a2) || exists2(~f=p, l1, l2) + | (_, _) => invalid_arg("List.exists2") + } + +let rec mem = (x, ~set) => + switch set { + | list{} => false + | list{a, ...l} => compare(a, x) == 0 || mem(x, ~set=l) + } + +let rec memq = (x, ~set) => + switch set { + | list{} => false + | list{a, ...l} => a === x || memq(x, ~set=l) + } + +let rec assoc = (x, param) => + switch param { + | list{} => raise(Not_found) + | list{(a, b), ...l} => + if compare(a, x) == 0 { + b + } else { + assoc(x, l) + } + } + +let rec assoc_opt = (x, param) => + switch param { + | list{} => None + | list{(a, b), ...l} => + if compare(a, x) == 0 { + Some(b) + } else { + assoc_opt(x, l) + } + } + +let rec assq = (x, param) => + switch param { + | list{} => raise(Not_found) + | list{(a, b), ...l} => + if a === x { + b + } else { + assq(x, l) + } + } + +let rec assq_opt = (x, param) => + switch param { + | list{} => None + | list{(a, b), ...l} => + if a === x { + Some(b) + } else { + assq_opt(x, l) + } + } + +let rec mem_assoc = (x, ~map) => + switch map { + | list{} => false + | list{(a, _), ...l} => compare(a, x) == 0 || mem_assoc(x, ~map=l) + } + +let rec mem_assq = (x, ~map) => + switch map { + | list{} => false + | list{(a, _), ...l} => a === x || mem_assq(x, ~map=l) + } + +let rec remove_assoc = (x, param) => + switch param { + | list{} => list{} + | list{(a, _) as pair, ...l} => + if compare(a, x) == 0 { + l + } else { + list{pair, ...remove_assoc(x, l)} + } + } + +let rec remove_assq = (x, param) => + switch param { + | list{} => list{} + | list{(a, _) as pair, ...l} => + if a === x { + l + } else { + list{pair, ...remove_assq(x, l)} + } + } + +let rec find = (~f as p, param) => + switch param { + | list{} => raise(Not_found) + | list{x, ...l} => + if p(x) { + x + } else { + find(~f=p, l) + } + } + +let rec find_opt = (~f as p, param) => + switch param { + | list{} => None + | list{x, ...l} => + if p(x) { + Some(x) + } else { + find_opt(~f=p, l) + } + } + +let find_all = (~f as p) => { + let rec find = (accu, param) => + switch param { + | list{} => rev(accu) + | list{x, ...l} => + if p(x) { + find(list{x, ...accu}, l) + } else { + find(accu, l) + } + } + find(list{}) +} + +let filter = find_all + +let partition = (~f as p, l) => { + let rec part = (yes, no, param) => + switch param { + | list{} => (rev(yes), rev(no)) + | list{x, ...l} => + if p(x) { + part(list{x, ...yes}, no, l) + } else { + part(yes, list{x, ...no}, l) + } + } + part(list{}, list{}, l) +} + +let rec split = param => + switch param { + | list{} => (list{}, list{}) + | list{(x, y), ...l} => + let (rx, ry) = split(l) + (list{x, ...rx}, list{y, ...ry}) + } + +let rec combine = (l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => list{} + | (list{a1, ...l1}, list{a2, ...l2}) => list{(a1, a2), ...combine(l1, l2)} + | (_, _) => invalid_arg("List.combine") + } + +@@ocaml.text(" sorting ") + +let rec merge = (~cmp, l1, l2) => + switch (l1, l2) { + | (list{}, l2) => l2 + | (l1, list{}) => l1 + | (list{h1, ...t1}, list{h2, ...t2}) => + if cmp(h1, h2) <= 0 { + list{h1, ...merge(~cmp, t1, l2)} + } else { + list{h2, ...merge(~cmp, l1, t2)} + } + } + +let rec chop = (k, l) => + if k == 0 { + l + } else { + switch l { + | list{_, ...t} => chop(k - 1, t) + | _ => assert(false) + } + } + +let stable_sort = (~cmp, l) => { + let rec rev_merge = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + if cmp(h1, h2) <= 0 { + rev_merge(t1, l2, list{h1, ...accu}) + } else { + rev_merge(l1, t2, list{h2, ...accu}) + } + } + + let rec rev_merge_rev = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + if cmp(h1, h2) > 0 { + rev_merge_rev(t1, l2, list{h1, ...accu}) + } else { + rev_merge_rev(l1, t2, list{h2, ...accu}) + } + } + + let rec sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + if cmp(x1, x2) <= 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + if cmp(x1, x2) <= 0 { + if cmp(x2, x3) <= 0 { + list{x1, x2, x3} + } else if cmp(x1, x3) <= 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } else if cmp(x1, x3) <= 0 { + list{x2, x1, x3} + } else if cmp(x2, x3) <= 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = rev_sort(n1, l) + let s2 = rev_sort(n2, l2) + rev_merge_rev(s1, s2, list{}) + } + and rev_sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + if cmp(x1, x2) > 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + if cmp(x1, x2) > 0 { + if cmp(x2, x3) > 0 { + list{x1, x2, x3} + } else if cmp(x1, x3) > 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } else if cmp(x1, x3) > 0 { + list{x2, x1, x3} + } else if cmp(x2, x3) > 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = sort(n1, l) + let s2 = sort(n2, l2) + rev_merge(s1, s2, list{}) + } + + let len = length(l) + if len < 2 { + l + } else { + sort(len, l) + } +} + +let sort = stable_sort +let fast_sort = stable_sort + +@@ocaml.text( + /* Note: on a list of length between about 100000 (depending on the minor + heap size and the type of the list) and Sys.max_array_size, it is + actually faster to use the following, but it might also use more memory + because the argument list cannot be deallocated incrementally. + + Also, there seems to be a bug in this code or in the + implementation of obj_truncate. + +external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" + +let array_to_list_in_place a = + let l = Array.length a in + let rec loop accu n p = + if p <= 0 then accu else begin + if p = n then begin + obj_truncate a p; + loop (a.(p-1) :: accu) (n-1000) (p-1) + end else begin + loop (a.(p-1) :: accu) n (p-1) + end + end + in + loop [] (l-1000) l + + +let stable_sort cmp l = + let a = Array.of_list l in + Array.stable_sort cmp a; + array_to_list_in_place a + +*/ + + " sorting + removing duplicates " +) + +let sort_uniq = (~cmp, l) => { + let rec rev_merge = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + let c = cmp(h1, h2) + if c == 0 { + rev_merge(t1, t2, list{h1, ...accu}) + } else if c < 0 { + rev_merge(t1, l2, list{h1, ...accu}) + } else { + rev_merge(l1, t2, list{h2, ...accu}) + } + } + + let rec rev_merge_rev = (l1, l2, accu) => + switch (l1, l2) { + | (list{}, l2) => rev_append(l2, accu) + | (l1, list{}) => rev_append(l1, accu) + | (list{h1, ...t1}, list{h2, ...t2}) => + let c = cmp(h1, h2) + if c == 0 { + rev_merge_rev(t1, t2, list{h1, ...accu}) + } else if c > 0 { + rev_merge_rev(t1, l2, list{h1, ...accu}) + } else { + rev_merge_rev(l1, t2, list{h2, ...accu}) + } + } + + let rec sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + list{x1} + } else if c < 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x2} + } else if c < 0 { + list{x2, x3} + } else { + list{x3, x2} + } + } else if c < 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x1, x2} + } else if c < 0 { + list{x1, x2, x3} + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x1, x2} + } else if c < 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x2, x1} + } else if c < 0 { + list{x2, x1, x3} + } else { + let c = cmp(x2, x3) + if c == 0 { + list{x2, x1} + } else if c < 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + } + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = rev_sort(n1, l) + let s2 = rev_sort(n2, l2) + rev_merge_rev(s1, s2, list{}) + } + and rev_sort = (n, l) => + switch (n, l) { + | (2, list{x1, x2, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + list{x1} + } else if c > 0 { + list{x1, x2} + } else { + list{x2, x1} + } + | (3, list{x1, x2, x3, ..._}) => + let c = cmp(x1, x2) + if c == 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x2} + } else if c > 0 { + list{x2, x3} + } else { + list{x3, x2} + } + } else if c > 0 { + let c = cmp(x2, x3) + if c == 0 { + list{x1, x2} + } else if c > 0 { + list{x1, x2, x3} + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x1, x2} + } else if c > 0 { + list{x1, x3, x2} + } else { + list{x3, x1, x2} + } + } + } else { + let c = cmp(x1, x3) + if c == 0 { + list{x2, x1} + } else if c > 0 { + list{x2, x1, x3} + } else { + let c = cmp(x2, x3) + if c == 0 { + list{x2, x1} + } else if c > 0 { + list{x2, x3, x1} + } else { + list{x3, x2, x1} + } + } + } + | (n, l) => + let n1 = asr(n, 1) + let n2 = n - n1 + let l2 = chop(n1, l) + let s1 = sort(n1, l) + let s2 = sort(n2, l2) + rev_merge(s1, s2, list{}) + } + + let len = length(l) + if len < 2 { + l + } else { + sort(len, l) + } +} + +let rec compare_lengths = (l1, l2) => + switch (l1, l2) { + | (list{}, list{}) => 0 + | (list{}, _) => -1 + | (_, list{}) => 1 + | (list{_, ...l1}, list{_, ...l2}) => compare_lengths(l1, l2) + } + +let rec compare_length_with = (l, ~len as n) => + switch l { + | list{} => + if n == 0 { + 0 + } else if n > 0 { + -1 + } else { + 1 + } + | list{_, ...l} => + if n <= 0 { + 1 + } else { + compare_length_with(l, ~len=n - 1) + } + } diff --git a/jscomp/stdlib-406/listLabels.resi b/jscomp/stdlib-406/listLabels.resi new file mode 100644 index 0000000000..cf6e45d91c --- /dev/null +++ b/jscomp/stdlib-406/listLabels.resi @@ -0,0 +1,337 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" List operations. + + Some functions are flagged as not tail-recursive. A tail-recursive + function uses constant stack space, while a non-tail-recursive function + uses stack space proportional to the length of its list argument, which + can be a problem with very long lists. When the function takes several + list arguments, an approximate formula giving stack usage (in some + unspecified constant unit) is shown in parentheses. + + The above considerations can usually be ignored if your lists are not + longer than about 10000 elements. +") + +@ocaml.doc(" Return the length (number of elements) of the given list. ") +let length: list<'a> => int + +@ocaml.doc(" Return the first element of the given list. Raise + [Failure \"hd\"] if the list is empty. ") +let hd: list<'a> => 'a + +@ocaml.doc(" Compare the lengths of two lists. [compare_lengths l1 l2] is + equivalent to [compare (length l1) (length l2)], except that + the computation stops after itering on the shortest list. + @since 4.05.0 + ") +let compare_lengths: (list<'a>, list<'b>) => int + +@ocaml.doc(" Compare the length of a list to an integer. [compare_length_with l n] is + equivalent to [compare (length l) n], except that + the computation stops after at most [n] iterations on the list. + @since 4.05.0 +") +let compare_length_with: (list<'a>, ~len: int) => int + +@ocaml.doc(" [cons x xs] is [x :: xs] + @since 4.05.0 +") +let cons: ('a, list<'a>) => list<'a> + +@ocaml.doc(" Return the given list without its first element. Raise + [Failure \"tl\"] if the list is empty. ") +let tl: list<'a> => list<'a> + +@ocaml.doc(" Return the [n]-th element of the given list. + The first element (head of the list) is at position 0. + Raise [Failure \"nth\"] if the list is too short. + Raise [Invalid_argument \"List.nth\"] if [n] is negative. ") +let nth: (list<'a>, int) => 'a + +@ocaml.doc(" Return the [n]-th element of the given list. + The first element (head of the list) is at position 0. + Return [None] if the list is too short. + Raise [Invalid_argument \"List.nth\"] if [n] is negative. + @since 4.05 +") +let nth_opt: (list<'a>, int) => option<'a> + +@ocaml.doc(" List reversal. ") +let rev: list<'a> => list<'a> + +@ocaml.doc(" [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. + + @raise Invalid_argument if [len < 0]. + @since 4.06.0 +") +let init: (~len: int, ~f: int => 'a) => list<'a> + +@ocaml.doc(" Catenate two lists. Same function as the infix operator [@]. + Not tail-recursive (length of the first argument). The [@] + operator is not tail-recursive either. ") +let append: (list<'a>, list<'a>) => list<'a> + +@ocaml.doc(" [List.rev_append l1 l2] reverses [l1] and concatenates it with [l2]. + This is equivalent to [(]{!List.rev}[ l1) @ l2], but [rev_append] is + tail-recursive and more efficient. ") +let rev_append: (list<'a>, list<'a>) => list<'a> + +@ocaml.doc(" Concatenate a list of lists. The elements of the argument are all + concatenated together (in the same order) to give the result. + Not tail-recursive + (length of the argument + length of the longest sub-list). ") +let concat: list> => list<'a> + +@ocaml.doc(" Same as [concat]. Not tail-recursive + (length of the argument + length of the longest sub-list). ") +let flatten: list> => list<'a> + +@@ocaml.text(" {1 Iterators} ") + +@ocaml.doc(" [List.iter f [a1; ...; an]] applies function [f] in turn to + [a1; ...; an]. It is equivalent to + [begin f a1; f a2; ...; f an; () end]. ") +let iter: (~f: 'a => unit, list<'a>) => unit + +@ocaml.doc(" Same as {!List.iter}, but the function is applied to the index of + the element as first argument (counting from 0), and the element + itself as second argument. + @since 4.00.0 +") +let iteri: (~f: (int, 'a) => unit, list<'a>) => unit + +@ocaml.doc(" [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], + and builds the list [[f a1; ...; f an]] + with the results returned by [f]. Not tail-recursive. ") +let map: (~f: 'a => 'b, list<'a>) => list<'b> + +@ocaml.doc(" Same as {!List.map}, but the function is applied to the index of + the element as first argument (counting from 0), and the element + itself as second argument. + @since 4.00.0 +") +let mapi: (~f: (int, 'a) => 'b, list<'a>) => list<'b> + +@ocaml.doc(" [List.rev_map f l] gives the same result as + {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and + more efficient. ") +let rev_map: (~f: 'a => 'b, list<'a>) => list<'b> + +@ocaml.doc(" [List.fold_left f a [b1; ...; bn]] is + [f (... (f (f a b1) b2) ...) bn]. ") +let fold_left: (~f: ('a, 'b) => 'a, ~init: 'a, list<'b>) => 'a + +@ocaml.doc(" [List.fold_right f [a1; ...; an] b] is + [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. ") +let fold_right: (~f: ('a, 'b) => 'b, list<'a>, ~init: 'b) => 'b + +@@ocaml.text(" {1 Iterators on two lists} ") + +@ocaml.doc(" [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn + [f a1 b1; ...; f an bn]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let iter2: (~f: ('a, 'b) => unit, list<'a>, list<'b>) => unit + +@ocaml.doc(" [List.map2 f [a1; ...; an] [b1; ...; bn]] is + [[f a1 b1; ...; f an bn]]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. Not tail-recursive. ") +let map2: (~f: ('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> + +@ocaml.doc(" [List.rev_map2 f l1 l2] gives the same result as + {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and + more efficient. ") +let rev_map2: (~f: ('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> + +@ocaml.doc(" [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is + [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let fold_left2: (~f: ('a, 'b, 'c) => 'a, ~init: 'a, list<'b>, list<'c>) => 'a + +@ocaml.doc(" [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is + [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. Not tail-recursive. ") +let fold_right2: (~f: ('a, 'b, 'c) => 'c, list<'a>, list<'b>, ~init: 'c) => 'c + +@@ocaml.text(" {1 List scanning} ") + +@ocaml.doc(" [for_all p [a1; ...; an]] checks if all elements of the list + satisfy the predicate [p]. That is, it returns + [(p a1) && (p a2) && ... && (p an)]. ") +let for_all: (~f: 'a => bool, list<'a>) => bool + +@ocaml.doc(" [exists p [a1; ...; an]] checks if at least one element of + the list satisfies the predicate [p]. That is, it returns + [(p a1) || (p a2) || ... || (p an)]. ") +let exists: (~f: 'a => bool, list<'a>) => bool + +@ocaml.doc(" Same as {!List.for_all}, but for a two-argument predicate. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let for_all2: (~f: ('a, 'b) => bool, list<'a>, list<'b>) => bool + +@ocaml.doc(" Same as {!List.exists}, but for a two-argument predicate. + Raise [Invalid_argument] if the two lists are determined + to have different lengths. ") +let exists2: (~f: ('a, 'b) => bool, list<'a>, list<'b>) => bool + +@ocaml.doc(" [mem a l] is true if and only if [a] is equal + to an element of [l]. ") +let mem: ('a, ~set: list<'a>) => bool + +@ocaml.doc(" Same as {!List.mem}, but uses physical equality instead of structural + equality to compare list elements. ") +let memq: ('a, ~set: list<'a>) => bool + +@@ocaml.text(" {1 List searching} ") + +@ocaml.doc(" [find p l] returns the first element of the list [l] + that satisfies the predicate [p]. + Raise [Not_found] if there is no value that satisfies [p] in the + list [l]. ") +let find: (~f: 'a => bool, list<'a>) => 'a + +@ocaml.doc(" [find p l] returns the first element of the list [l] + that satisfies the predicate [p]. + Returns [None] if there is no value that satisfies [p] in the + list [l]. + @since 4.05 ") +let find_opt: (~f: 'a => bool, list<'a>) => option<'a> + +@ocaml.doc(" [filter p l] returns all the elements of the list [l] + that satisfy the predicate [p]. The order of the elements + in the input list is preserved. ") +let filter: (~f: 'a => bool, list<'a>) => list<'a> + +@ocaml.doc(" [find_all] is another name for {!List.filter}. ") +let find_all: (~f: 'a => bool, list<'a>) => list<'a> + +@ocaml.doc(" [partition p l] returns a pair of lists [(l1, l2)], where + [l1] is the list of all the elements of [l] that + satisfy the predicate [p], and [l2] is the list of all the + elements of [l] that do not satisfy [p]. + The order of the elements in the input list is preserved. ") +let partition: (~f: 'a => bool, list<'a>) => (list<'a>, list<'a>) + +@@ocaml.text(" {1 Association lists} ") + +@ocaml.doc(" [assoc a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Raise [Not_found] if there is no value associated with [a] in the + list [l]. ") +let assoc: ('a, list<('a, 'b)>) => 'b + +@ocaml.doc(" [assoc_opt a l] returns the value associated with key [a] in the list of + pairs [l]. That is, + [assoc a [ ...; (a,b); ...] = b] + if [(a,b)] is the leftmost binding of [a] in list [l]. + Returns [None] if there is no value associated with [a] in the + list [l]. + @since 4.05 +") +let assoc_opt: ('a, list<('a, 'b)>) => option<'b> + +@ocaml.doc(" Same as {!List.assoc}, but uses physical equality instead of + structural equality to compare keys. ") +let assq: ('a, list<('a, 'b)>) => 'b + +@ocaml.doc(" Same as {!List.assoc_opt}, but uses physical equality instead of + structural equality to compare keys. + @since 4.05.0 ") +let assq_opt: ('a, list<('a, 'b)>) => option<'b> + +@ocaml.doc(" Same as {!List.assoc}, but simply return true if a binding exists, + and false if no bindings exist for the given key. ") +let mem_assoc: ('a, ~map: list<('a, 'b)>) => bool + +@ocaml.doc(" Same as {!List.mem_assoc}, but uses physical equality instead of + structural equality to compare keys. ") +let mem_assq: ('a, ~map: list<('a, 'b)>) => bool + +@ocaml.doc(" [remove_assoc a l] returns the list of + pairs [l] without the first pair with key [a], if any. + Not tail-recursive. ") +let remove_assoc: ('a, list<('a, 'b)>) => list<('a, 'b)> + +@ocaml.doc(" Same as {!List.remove_assoc}, but uses physical equality instead + of structural equality to compare keys. Not tail-recursive. ") +let remove_assq: ('a, list<('a, 'b)>) => list<('a, 'b)> + +@@ocaml.text(" {1 Lists of pairs} ") + +@ocaml.doc(" Transform a list of pairs into a pair of lists: + [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. + Not tail-recursive. +") +let split: list<('a, 'b)> => (list<'a>, list<'b>) + +@ocaml.doc(" Transform a pair of lists into a list of pairs: + [combine [a1; ...; an] [b1; ...; bn]] is + [[(a1,b1); ...; (an,bn)]]. + Raise [Invalid_argument] if the two lists + have different lengths. Not tail-recursive. ") +let combine: (list<'a>, list<'b>) => list<('a, 'b)> + +@@ocaml.text(" {1 Sorting} ") + +@ocaml.doc(" Sort a list in increasing order according to a comparison + function. The comparison function must return 0 if its arguments + compare as equal, a positive integer if the first is greater, + and a negative integer if the first is smaller (see Array.sort for + a complete specification). For example, + {!Pervasives.compare} is a suitable comparison function. + The resulting list is sorted in increasing order. + [List.sort] is guaranteed to run in constant heap space + (in addition to the size of the result list) and logarithmic + stack space. + + The current implementation uses Merge Sort. It runs in constant + heap space and logarithmic stack space. +") +let sort: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Same as {!List.sort}, but the sorting algorithm is guaranteed to + be stable (i.e. elements that compare equal are kept in their + original order) . + + The current implementation uses Merge Sort. It runs in constant + heap space and logarithmic stack space. +") +let stable_sort: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Same as {!List.sort} or {!List.stable_sort}, whichever is + faster on typical input. ") +let fast_sort: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Same as {!List.sort}, but also remove duplicates. + @since 4.03.0 ") +let sort_uniq: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> + +@ocaml.doc(" Merge two lists: + Assuming that [l1] and [l2] are sorted according to the + comparison function [cmp], [merge cmp l1 l2] will return a + sorted list containing all the elements of [l1] and [l2]. + If several elements compare equal, the elements of [l1] will be + before the elements of [l2]. + Not tail-recursive (sum of the lengths of the arguments). +") +let merge: (~cmp: ('a, 'a) => int, list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/map.ml b/jscomp/stdlib-406/map.ml deleted file mode 100644 index 7d096dfb3c..0000000000 --- a/jscomp/stdlib-406/map.ml +++ /dev/null @@ -1,480 +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. *) -(* *) -(**************************************************************************) - -module type OrderedType = - sig - type t - val compare: t -> t -> int - end - -module type S = - sig - type key - type +'a t - val empty: 'a t - val is_empty: 'a t -> bool - val mem: key -> 'a t -> bool - val add: key -> 'a -> 'a t -> 'a t - val update: key -> ('a option -> 'a option) -> 'a t -> 'a t - val singleton: key -> 'a -> 'a t - val remove: key -> 'a t -> 'a t - val merge: - (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter: (key -> 'a -> unit) -> 'a t -> unit - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - val for_all: (key -> 'a -> bool) -> 'a t -> bool - val exists: (key -> 'a -> bool) -> 'a t -> bool - val filter: (key -> 'a -> bool) -> 'a t -> 'a t - val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val cardinal: 'a t -> int - val bindings: 'a t -> (key * 'a) list - val min_binding: 'a t -> (key * 'a) - val min_binding_opt: 'a t -> (key * 'a) option - val max_binding: 'a t -> (key * 'a) - val max_binding_opt: 'a t -> (key * 'a) option - val choose: 'a t -> (key * 'a) - val choose_opt: 'a t -> (key * 'a) option - val split: key -> 'a t -> 'a t * 'a option * 'a t - val find: key -> 'a t -> 'a - val find_opt: key -> 'a t -> 'a option - val find_first: (key -> bool) -> 'a t -> key * 'a - val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option - val find_last: (key -> bool) -> 'a t -> key * 'a - val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option - val map: ('a -> 'b) -> 'a t -> 'b t - val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t - end - -module Make(Ord: OrderedType) = struct - - type key = Ord.t - - type 'a t = - Empty - | Node of {l:'a t; v:key; d:'a; r:'a t; h:int} - - let height = function - Empty -> 0 - | Node {h} -> h - - let create l x d r = - let hl = height l and hr = height r in - Node{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - let singleton x d = Node{l=Empty; v=x; d; r=Empty; h=1} - - let bal l x d r = - let hl = match l with Empty -> 0 | Node {h} -> h in - let hr = match r with Empty -> 0 | Node {h} -> h in - if hl > hr + 2 then begin - match l with - Empty -> invalid_arg "Map.bal" - | Node{l=ll; v=lv; d=ld; r=lr} -> - if height ll >= height lr then - create ll lv ld (create lr x d r) - else begin - match lr with - Empty -> invalid_arg "Map.bal" - | Node{l=lrl; v=lrv; d=lrd; r=lrr}-> - create (create ll lv ld lrl) lrv lrd (create lrr x d r) - end - end else if hr > hl + 2 then begin - match r with - Empty -> invalid_arg "Map.bal" - | Node{l=rl; v=rv; d=rd; r=rr} -> - if height rr >= height rl then - create (create l x d rl) rv rd rr - else begin - match rl with - Empty -> invalid_arg "Map.bal" - | Node{l=rll; v=rlv; d=rld; r=rlr} -> - create (create l x d rll) rlv rld (create rlr rv rd rr) - end - end else - Node{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - let empty = Empty - - let is_empty = function Empty -> true | _ -> false - - let rec add x data = function - Empty -> - Node{l=Empty; v=x; d=data; r=Empty; h=1} - | Node {l; v; d; r; h} as m -> - let c = Ord.compare x v in - if c = 0 then - if d == data then m else Node{l; v=x; d=data; r; h} - else if c < 0 then - let ll = add x data l in - if l == ll then m else bal ll v d r - else - let rr = add x data r in - if r == rr then m else bal l v d rr - - let rec find x = function - Empty -> - raise Not_found - | Node {l; v; d; r} -> - let c = Ord.compare x v in - if c = 0 then d - else find x (if c < 0 then l else r) - - let rec find_first_aux v0 d0 f = function - Empty -> - (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_first_aux v d f l - else - find_first_aux v0 d0 f r - - let rec find_first f = function - Empty -> - raise Not_found - | Node {l; v; d; r} -> - if f v then - find_first_aux v d f l - else - find_first f r - - let rec find_first_opt_aux v0 d0 f = function - Empty -> - Some (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_first_opt_aux v d f l - else - find_first_opt_aux v0 d0 f r - - let rec find_first_opt f = function - Empty -> - None - | Node {l; v; d; r} -> - if f v then - find_first_opt_aux v d f l - else - find_first_opt f r - - let rec find_last_aux v0 d0 f = function - Empty -> - (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_last_aux v d f r - else - find_last_aux v0 d0 f l - - let rec find_last f = function - Empty -> - raise Not_found - | Node {l; v; d; r} -> - if f v then - find_last_aux v d f r - else - find_last f l - - let rec find_last_opt_aux v0 d0 f = function - Empty -> - Some (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_last_opt_aux v d f r - else - find_last_opt_aux v0 d0 f l - - let rec find_last_opt f = function - Empty -> - None - | Node {l; v; d; r} -> - if f v then - find_last_opt_aux v d f r - else - find_last_opt f l - - let rec find_opt x = function - Empty -> - None - | Node {l; v; d; r} -> - let c = Ord.compare x v in - if c = 0 then Some d - else find_opt x (if c < 0 then l else r) - - let rec mem x = function - Empty -> - false - | Node {l; v; r} -> - let c = Ord.compare x v in - c = 0 || mem x (if c < 0 then l else r) - - let rec min_binding = function - Empty -> raise Not_found - | Node {l=Empty; v; d} -> (v, d) - | Node {l} -> min_binding l - - let rec min_binding_opt = function - Empty -> None - | Node {l=Empty; v; d} -> Some (v, d) - | Node {l}-> min_binding_opt l - - let rec max_binding = function - Empty -> raise Not_found - | Node {v; d; r=Empty} -> (v, d) - | Node {r} -> max_binding r - - let rec max_binding_opt = function - Empty -> None - | Node {v; d; r=Empty} -> Some (v, d) - | Node {r} -> max_binding_opt r - - let rec remove_min_binding = function - Empty -> invalid_arg "Map.remove_min_elt" - | Node {l=Empty; r} -> r - | Node {l; v; d; r} -> bal (remove_min_binding l) v d r - - let merge t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> - let (x, d) = min_binding t2 in - bal t1 x d (remove_min_binding t2) - - let rec remove x = function - Empty -> - Empty - | (Node {l; v; d; r} as m) -> - let c = Ord.compare x v in - if c = 0 then merge l r - else if c < 0 then - let ll = remove x l in if l == ll then m else bal ll v d r - else - let rr = remove x r in if r == rr then m else bal l v d rr - - let rec update x f = function - Empty -> - begin match f None with - | None -> Empty - | Some data -> Node{l=Empty; v=x; d=data; r=Empty; h=1} - end - | Node {l; v; d; r; h} as m -> - let c = Ord.compare x v in - if c = 0 then begin - match f (Some d) with - | None -> merge l r - | Some data -> - if d == data then m else Node{l; v=x; d=data; r; h} - end else if c < 0 then - let ll = update x f l in - if l == ll then m else bal ll v d r - else - let rr = update x f r in - if r == rr then m else bal l v d rr - - let rec iter f = function - Empty -> () - | Node {l; v; d; r} -> - iter f l; f v d; iter f r - - let rec map f = function - Empty -> - Empty - | Node {l; v; d; r; h} -> - let l' = map f l in - let d' = f d in - let r' = map f r in - Node{l=l'; v; d=d'; r=r'; h} - - let rec mapi f = function - Empty -> - Empty - | Node {l; v; d; r; h} -> - let l' = mapi f l in - let d' = f v d in - let r' = mapi f r in - Node{l=l'; v; d=d'; r=r'; h} - - let rec fold f m accu = - match m with - Empty -> accu - | Node {l; v; d; r} -> - fold f r (f v d (fold f l accu)) - - let rec for_all p = function - Empty -> true - | Node {l; v; d; r} -> p v d && for_all p l && for_all p r - - let rec exists p = function - Empty -> false - | Node {l; v; d; r} -> p v d || exists p l || exists p r - - (* Beware: those two functions assume that the added k is *strictly* - smaller (or bigger) than all the present keys in the tree; it - does not test for equality with the current min (or max) key. - - Indeed, they are only used during the "join" operation which - respects this precondition. - *) - - let rec add_min_binding k x = function - | Empty -> singleton k x - | Node {l; v; d; r} -> - bal (add_min_binding k x l) v d r - - let rec add_max_binding k x = function - | Empty -> singleton k x - | Node {l; v; d; r} -> - bal l v d (add_max_binding k x r) - - (* Same as create and bal, but no assumptions are made on the - relative heights of l and r. *) - - let rec join l v d r = - match (l, r) with - (Empty, _) -> add_min_binding v d r - | (_, Empty) -> add_max_binding v d l - | (Node{l=ll; v=lv; d=ld; r=lr; h=lh}, Node{l=rl; v=rv; d=rd; r=rr; h=rh}) -> - if lh > rh + 2 then bal ll lv ld (join lr v d r) else - if rh > lh + 2 then bal (join l v d rl) rv rd rr else - create l v d r - - (* Merge two trees l and r into one. - All elements of l must precede the elements of r. - No assumption on the heights of l and r. *) - - let concat t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> - let (x, d) = min_binding t2 in - join t1 x d (remove_min_binding t2) - - let concat_or_join t1 v d t2 = - match d with - | Some d -> join t1 v d t2 - | None -> concat t1 t2 - - let rec split x = function - Empty -> - (Empty, None, Empty) - | Node {l; v; d; r} -> - let c = Ord.compare x v in - if c = 0 then (l, Some d, r) - else if c < 0 then - let (ll, pres, rl) = split x l in (ll, pres, join rl v d r) - else - let (lr, pres, rr) = split x r in (join l v d lr, pres, rr) - - let rec merge f s1 s2 = - match (s1, s2) with - (Empty, Empty) -> Empty - | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, _) when h1 >= height s2 -> - let (l2, d2, r2) = split v1 s2 in - concat_or_join (merge f l1 l2) v1 (f v1 (Some d1) d2) (merge f r1 r2) - | (_, Node {l=l2; v=v2; d=d2; r=r2}) -> - let (l1, d1, r1) = split v2 s1 in - concat_or_join (merge f l1 l2) v2 (f v2 d1 (Some d2)) (merge f r1 r2) - | _ -> - assert false - - let rec union f s1 s2 = - match (s1, s2) with - | (Empty, s) | (s, Empty) -> s - | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, Node {l=l2; v=v2; d=d2; r=r2; h=h2}) -> - if h1 >= h2 then - let (l2, d2, r2) = split v1 s2 in - let l = union f l1 l2 and r = union f r1 r2 in - match d2 with - | None -> join l v1 d1 r - | Some d2 -> concat_or_join l v1 (f v1 d1 d2) r - else - let (l1, d1, r1) = split v2 s1 in - let l = union f l1 l2 and r = union f r1 r2 in - match d1 with - | None -> join l v2 d2 r - | Some d1 -> concat_or_join l v2 (f v2 d1 d2) r - - let rec filter p = function - Empty -> Empty - | Node {l; v; d; r} as m -> - (* call [p] in the expected left-to-right order *) - let l' = filter p l in - let pvd = p v d in - let r' = filter p r in - if pvd then if l==l' && r==r' then m else join l' v d r' - else concat l' r' - - let rec partition p = function - Empty -> (Empty, Empty) - | Node {l; v; d; r} -> - (* call [p] in the expected left-to-right order *) - let (lt, lf) = partition p l in - let pvd = p v d in - let (rt, rf) = partition p r in - if pvd - then (join lt v d rt, concat lf rf) - else (concat lt rt, join lf v d rf) - - type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration - - let rec cons_enum m e = - match m with - Empty -> e - | Node {l; v; d; r} -> cons_enum l (More(v, d, r, e)) - - let compare cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 then c else - let c = cmp d1 d2 in - if c <> 0 then c else - compare_aux (cons_enum r1 e1) (cons_enum r2 e2) - in compare_aux (cons_enum m1 End) (cons_enum m2 End) - - let equal cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - Ord.compare v1 v2 = 0 && cmp d1 d2 && - equal_aux (cons_enum r1 e1) (cons_enum r2 e2) - in equal_aux (cons_enum m1 End) (cons_enum m2 End) - - let rec cardinal = function - Empty -> 0 - | Node {l; r} -> cardinal l + 1 + cardinal r - - let rec bindings_aux accu = function - Empty -> accu - | Node {l; v; d; r} -> bindings_aux ((v, d) :: bindings_aux accu r) l - - let bindings s = - bindings_aux [] s - - let choose = min_binding - - let choose_opt = min_binding_opt - -end diff --git a/jscomp/stdlib-406/map.res b/jscomp/stdlib-406/map.res new file mode 100644 index 0000000000..f485f302e2 --- /dev/null +++ b/jscomp/stdlib-406/map.res @@ -0,0 +1,669 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +module type OrderedType = { + type t + let compare: (t, t) => int +} + +module type S = { + type key + type t<+'a> + let empty: t<'a> + let is_empty: t<'a> => bool + let mem: (key, t<'a>) => bool + let add: (key, 'a, t<'a>) => t<'a> + let update: (key, option<'a> => option<'a>, t<'a>) => t<'a> + let singleton: (key, 'a) => t<'a> + let remove: (key, t<'a>) => t<'a> + let merge: ((key, option<'a>, option<'b>) => option<'c>, t<'a>, t<'b>) => t<'c> + let union: ((key, 'a, 'a) => option<'a>, t<'a>, t<'a>) => t<'a> + let compare: (('a, 'a) => int, t<'a>, t<'a>) => int + let equal: (('a, 'a) => bool, t<'a>, t<'a>) => bool + let iter: ((key, 'a) => unit, t<'a>) => unit + let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b + let for_all: ((key, 'a) => bool, t<'a>) => bool + let exists: ((key, 'a) => bool, t<'a>) => bool + let filter: ((key, 'a) => bool, t<'a>) => t<'a> + let partition: ((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: (key => bool, t<'a>) => (key, 'a) + let find_first_opt: (key => bool, t<'a>) => option<(key, 'a)> + let find_last: (key => bool, t<'a>) => (key, 'a) + let find_last_opt: (key => bool, t<'a>) => option<(key, 'a)> + let map: ('a => 'b, t<'a>) => t<'b> + let mapi: ((key, 'a) => 'b, t<'a>) => t<'b> +} + +module Make = (Ord: OrderedType) => { + type key = Ord.t + + type rec t<'a> = + | Empty + | Node({l: t<'a>, v: key, d: 'a, r: t<'a>, h: int}) + + let height = param => + switch param { + | Empty => 0 + | Node({h}) => h + } + + let create = (l, x, d, r) => { + let hl = height(l) and hr = height(r) + Node({ + l, + v: x, + d, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + + let singleton = (x, d) => Node({l: Empty, v: x, d, r: Empty, h: 1}) + + let bal = (l, x, d, r) => { + let hl = switch l { + | Empty => 0 + | Node({h}) => h + } + let hr = switch r { + | Empty => 0 + | Node({h}) => h + } + if hl > hr + 2 { + switch l { + | Empty => invalid_arg("Map.bal") + | Node({l: ll, v: lv, d: ld, r: lr}) => + if height(ll) >= height(lr) { + create(ll, lv, ld, create(lr, x, d, r)) + } else { + switch lr { + | Empty => invalid_arg("Map.bal") + | Node({l: lrl, v: lrv, d: lrd, r: lrr}) => + create(create(ll, lv, ld, lrl), lrv, lrd, create(lrr, x, d, r)) + } + } + } + } else if hr > hl + 2 { + switch r { + | Empty => invalid_arg("Map.bal") + | Node({l: rl, v: rv, d: rd, r: rr}) => + if height(rr) >= height(rl) { + create(create(l, x, d, rl), rv, rd, rr) + } else { + switch rl { + | Empty => invalid_arg("Map.bal") + | Node({l: rll, v: rlv, d: rld, r: rlr}) => + create(create(l, x, d, rll), rlv, rld, create(rlr, rv, rd, rr)) + } + } + } + } else { + Node({ + l, + v: x, + d, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + } + + let empty = Empty + + let is_empty = param => + switch param { + | Empty => true + | _ => false + } + + let rec add = (x, data, param) => + switch param { + | Empty => Node({l: Empty, v: x, d: data, r: Empty, h: 1}) + | Node({l, v, d, r, h}) as m => + let c = Ord.compare(x, v) + if c == 0 { + if d === data { + m + } else { + Node({l, v: x, d: data, r, h}) + } + } else if c < 0 { + let ll = add(x, data, l) + if l === ll { + m + } else { + bal(ll, v, d, r) + } + } else { + let rr = add(x, data, r) + if r === rr { + m + } else { + bal(l, v, d, rr) + } + } + } + + let rec find = (x, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, d, r}) => + let c = Ord.compare(x, v) + if c == 0 { + d + } else { + find( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let rec find_first_aux = (v0, d0, f, param) => + switch param { + | Empty => (v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_first_aux(v, d, f, l) + } else { + find_first_aux(v0, d0, f, r) + } + } + + let rec find_first = (f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, d, r}) => + if f(v) { + find_first_aux(v, d, f, l) + } else { + find_first(f, r) + } + } + + let rec find_first_opt_aux = (v0, d0, f, param) => + switch param { + | Empty => Some(v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_first_opt_aux(v, d, f, l) + } else { + find_first_opt_aux(v0, d0, f, r) + } + } + + let rec find_first_opt = (f, param) => + switch param { + | Empty => None + | Node({l, v, d, r}) => + if f(v) { + find_first_opt_aux(v, d, f, l) + } else { + find_first_opt(f, r) + } + } + + let rec find_last_aux = (v0, d0, f, param) => + switch param { + | Empty => (v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_last_aux(v, d, f, r) + } else { + find_last_aux(v0, d0, f, l) + } + } + + let rec find_last = (f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, d, r}) => + if f(v) { + find_last_aux(v, d, f, r) + } else { + find_last(f, l) + } + } + + let rec find_last_opt_aux = (v0, d0, f, param) => + switch param { + | Empty => Some(v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_last_opt_aux(v, d, f, r) + } else { + find_last_opt_aux(v0, d0, f, l) + } + } + + let rec find_last_opt = (f, param) => + switch param { + | Empty => None + | Node({l, v, d, r}) => + if f(v) { + find_last_opt_aux(v, d, f, r) + } else { + find_last_opt(f, l) + } + } + + let rec find_opt = (x, param) => + switch param { + | Empty => None + | Node({l, v, d, r}) => + let c = Ord.compare(x, v) + if c == 0 { + Some(d) + } else { + find_opt( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let rec mem = (x, param) => + switch param { + | Empty => false + | Node({l, v, r}) => + let c = Ord.compare(x, v) + c == 0 || + mem( + x, + if c < 0 { + l + } else { + r + }, + ) + } + + let rec min_binding = param => + switch param { + | Empty => raise(Not_found) + | Node({l: Empty, v, d}) => (v, d) + | Node({l}) => min_binding(l) + } + + let rec min_binding_opt = param => + switch param { + | Empty => None + | Node({l: Empty, v, d}) => Some(v, d) + | Node({l}) => min_binding_opt(l) + } + + let rec max_binding = param => + switch param { + | Empty => raise(Not_found) + | Node({v, d, r: Empty}) => (v, d) + | Node({r}) => max_binding(r) + } + + let rec max_binding_opt = param => + switch param { + | Empty => None + | Node({v, d, r: Empty}) => Some(v, d) + | Node({r}) => max_binding_opt(r) + } + + let rec remove_min_binding = param => + switch param { + | Empty => invalid_arg("Map.remove_min_elt") + | Node({l: Empty, r}) => r + | Node({l, v, d, r}) => bal(remove_min_binding(l), v, d, r) + } + + let merge = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => + let (x, d) = min_binding(t2) + bal(t1, x, d, remove_min_binding(t2)) + } + + let rec remove = (x, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r}) as m => + let c = Ord.compare(x, v) + if c == 0 { + merge(l, r) + } else if c < 0 { + let ll = remove(x, l) + if l === ll { + m + } else { + bal(ll, v, d, r) + } + } else { + let rr = remove(x, r) + if r === rr { + m + } else { + bal(l, v, d, rr) + } + } + } + + let rec update = (x, f, param) => + switch param { + | Empty => + switch f(None) { + | None => Empty + | Some(data) => Node({l: Empty, v: x, d: data, r: Empty, h: 1}) + } + | Node({l, v, d, r, h}) as m => + let c = Ord.compare(x, v) + if c == 0 { + switch f(Some(d)) { + | None => merge(l, r) + | Some(data) => + if d === data { + m + } else { + Node({l, v: x, d: data, r, h}) + } + } + } else if c < 0 { + let ll = update(x, f, l) + if l === ll { + m + } else { + bal(ll, v, d, r) + } + } else { + let rr = update(x, f, r) + if r === rr { + m + } else { + bal(l, v, d, rr) + } + } + } + + let rec iter = (f, param) => + switch param { + | Empty => () + | Node({l, v, d, r}) => + iter(f, l) + f(v, d) + iter(f, r) + } + + let rec map = (f, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r, h}) => + let l' = map(f, l) + let d' = f(d) + let r' = map(f, r) + Node({l: l', v, d: d', r: r', h}) + } + + let rec mapi = (f, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r, h}) => + let l' = mapi(f, l) + let d' = f(v, d) + let r' = mapi(f, r) + Node({l: l', v, d: d', r: r', h}) + } + + let rec fold = (f, m, accu) => + switch m { + | Empty => accu + | Node({l, v, d, r}) => fold(f, r, f(v, d, fold(f, l, accu))) + } + + let rec for_all = (p, param) => + switch param { + | Empty => true + | Node({l, v, d, r}) => p(v, d) && (for_all(p, l) && for_all(p, r)) + } + + let rec exists = (p, param) => + switch param { + | Empty => false + | Node({l, v, d, r}) => p(v, d) || (exists(p, l) || exists(p, r)) + } + + /* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. + */ + + let rec add_min_binding = (k, x, param) => + switch param { + | Empty => singleton(k, x) + | Node({l, v, d, r}) => bal(add_min_binding(k, x, l), v, d, r) + } + + let rec add_max_binding = (k, x, param) => + switch param { + | Empty => singleton(k, x) + | Node({l, v, d, r}) => bal(l, v, d, add_max_binding(k, x, r)) + } + + /* Same as create and bal, but no assumptions are made on the + relative heights of l and r. */ + + let rec join = (l, v, d, r) => + switch (l, r) { + | (Empty, _) => add_min_binding(v, d, r) + | (_, Empty) => add_max_binding(v, d, l) + | (Node({l: ll, v: lv, d: ld, r: lr, h: lh}), Node({l: rl, v: rv, d: rd, r: rr, h: rh})) => + if lh > rh + 2 { + bal(ll, lv, ld, join(lr, v, d, r)) + } else if rh > lh + 2 { + bal(join(l, v, d, rl), rv, rd, rr) + } else { + create(l, v, d, r) + } + } + + /* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. */ + + let concat = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => + let (x, d) = min_binding(t2) + join(t1, x, d, remove_min_binding(t2)) + } + + let concat_or_join = (t1, v, d, t2) => + switch d { + | Some(d) => join(t1, v, d, t2) + | None => concat(t1, t2) + } + + let rec split = (x, param) => + switch param { + | Empty => (Empty, None, Empty) + | Node({l, v, d, r}) => + let c = Ord.compare(x, v) + if c == 0 { + (l, Some(d), r) + } else if c < 0 { + let (ll, pres, rl) = split(x, l) + (ll, pres, join(rl, v, d, r)) + } else { + let (lr, pres, rr) = split(x, r) + (join(l, v, d, lr), pres, rr) + } + } + + let rec merge = (f, s1, s2) => + switch (s1, s2) { + | (Empty, Empty) => Empty + | (Node({l: l1, v: v1, d: d1, r: r1, h: h1}), _) if h1 >= height(s2) => + let (l2, d2, r2) = split(v1, s2) + concat_or_join(merge(f, l1, l2), v1, f(v1, Some(d1), d2), merge(f, r1, r2)) + | (_, Node({l: l2, v: v2, d: d2, r: r2})) => + let (l1, d1, r1) = split(v2, s1) + concat_or_join(merge(f, l1, l2), v2, f(v2, d1, Some(d2)), merge(f, r1, r2)) + | _ => assert(false) + } + + let rec union = (f, s1, s2) => + switch (s1, s2) { + | (Empty, s) | (s, Empty) => s + | (Node({l: l1, v: v1, d: d1, r: r1, h: h1}), Node({l: l2, v: v2, d: d2, r: r2, h: h2})) => + if h1 >= h2 { + let (l2, d2, r2) = split(v1, s2) + let l = union(f, l1, l2) and r = union(f, r1, r2) + switch d2 { + | None => join(l, v1, d1, r) + | Some(d2) => concat_or_join(l, v1, f(v1, d1, d2), r) + } + } else { + let (l1, d1, r1) = split(v2, s1) + let l = union(f, l1, l2) and r = union(f, r1, r2) + switch d1 { + | None => join(l, v2, d2, r) + | Some(d1) => concat_or_join(l, v2, f(v2, d1, d2), r) + } + } + } + + let rec filter = (p, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r}) as m => + /* call [p] in the expected left-to-right order */ + let l' = filter(p, l) + let pvd = p(v, d) + let r' = filter(p, r) + if pvd { + if l === l' && r === r' { + m + } else { + join(l', v, d, r') + } + } else { + concat(l', r') + } + } + + let rec partition = (p, param) => + switch param { + | Empty => (Empty, Empty) + | Node({l, v, d, r}) => + /* call [p] in the expected left-to-right order */ + let (lt, lf) = partition(p, l) + let pvd = p(v, d) + let (rt, rf) = partition(p, r) + if pvd { + (join(lt, v, d, rt), concat(lf, rf)) + } else { + (concat(lt, rt), join(lf, v, d, rf)) + } + } + + type rec enumeration<'a> = End | More(key, 'a, t<'a>, enumeration<'a>) + + let rec cons_enum = (m, e) => + switch m { + | Empty => e + | Node({l, v, d, r}) => cons_enum(l, More(v, d, r, e)) + } + + let compare = (cmp, m1, m2) => { + let rec compare_aux = (e1, e2) => + switch (e1, e2) { + | (End, End) => 0 + | (End, _) => -1 + | (_, End) => 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) => + let c = Ord.compare(v1, v2) + if c != 0 { + c + } else { + let c = cmp(d1, d2) + if c != 0 { + c + } else { + compare_aux(cons_enum(r1, e1), cons_enum(r2, e2)) + } + } + } + compare_aux(cons_enum(m1, End), cons_enum(m2, End)) + } + + let equal = (cmp, m1, m2) => { + let rec equal_aux = (e1, e2) => + switch (e1, e2) { + | (End, End) => true + | (End, _) => false + | (_, End) => false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) => + Ord.compare(v1, v2) == 0 && (cmp(d1, d2) && equal_aux(cons_enum(r1, e1), cons_enum(r2, e2))) + } + equal_aux(cons_enum(m1, End), cons_enum(m2, End)) + } + + let rec cardinal = param => + switch param { + | Empty => 0 + | Node({l, r}) => cardinal(l) + 1 + cardinal(r) + } + + let rec bindings_aux = (accu, param) => + switch param { + | Empty => accu + | Node({l, v, d, r}) => bindings_aux(list{(v, d), ...bindings_aux(accu, r)}, l) + } + + let bindings = s => bindings_aux(list{}, s) + + let choose = min_binding + + let choose_opt = min_binding_opt +} diff --git a/jscomp/stdlib-406/map.mli b/jscomp/stdlib-406/map.resi similarity index 50% rename from jscomp/stdlib-406/map.mli rename to jscomp/stdlib-406/map.resi index 7552c480a5..404726fc6e 100644 --- a/jscomp/stdlib-406/map.mli +++ b/jscomp/stdlib-406/map.resi @@ -1,19 +1,19 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -(** Association tables over ordered types. +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Association tables over ordered types. This module implements applicative association tables, also known as finite maps or dictionaries, given a total ordering function @@ -35,59 +35,57 @@ module PairsMap = Map.Make(IntPairs) - let m = PairsMap.(empty |> add (0,1) "hello" |> add (1,0) "world") + let m = PairsMap.(empty |> add (0,1) \"hello\" |> add (1,0) \"world\") ]} This creates a new module [PairsMap], with a new type ['a PairsMap.t] of maps from [int * int] to ['a]. In this example, [m] contains [string] values so its type is [string PairsMap.t]. -*) +") -module type OrderedType = - sig - type t - (** The type of the map keys. *) +@ocaml.doc(" Input signature of the functor {!Map.Make}. ") +module type OrderedType = { + @ocaml.doc(" The type of the map keys. ") + type t - val compare : t -> t -> int - (** A total ordering function over the keys. + @ocaml.doc(" A total ordering function over the keys. This is a two-argument function [f] such that [f e1 e2] is zero if the keys [e1] and [e2] are equal, [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. *) - end -(** Input signature of the functor {!Map.Make}. *) + comparison function {!Pervasives.compare}. ") + let compare: (t, t) => int +} -module type S = - sig - type key - (** The type of the map keys. *) +@ocaml.doc(" Output signature of the functor {!Map.Make}. ") +module type S = { + @ocaml.doc(" The type of the map keys. ") + type key - type (+'a) t - (** The type of maps from type [key] to type ['a]. *) + @ocaml.doc(" The type of maps from type [key] to type ['a]. ") + type t<+'a> - val empty: 'a t - (** The empty map. *) + @ocaml.doc(" The empty map. ") + let empty: t<'a> - val is_empty: 'a t -> bool - (** Test whether a map is empty or not. *) + @ocaml.doc(" Test whether a map is empty or not. ") + let is_empty: t<'a> => bool - val mem: key -> 'a t -> bool - (** [mem x m] returns [true] if [m] contains a binding for [x], - and [false] otherwise. *) + @ocaml.doc(" [mem x m] returns [true] if [m] contains a binding for [x], + and [false] otherwise. ") + let mem: (key, t<'a>) => bool - val add: key -> 'a -> 'a t -> 'a t - (** [add x y m] returns a map containing the same bindings as + @ocaml.doc(" [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m] to a value that is physically equal to [y], [m] is returned unchanged (the result of the function is then physically equal to [m]). Otherwise, the previous binding of [x] in [m] disappears. - @before 4.03 Physical equality was not ensured. *) + @before 4.03 Physical equality was not ensured. ") + let add: (key, 'a, t<'a>) => t<'a> - val update: key -> ('a option -> 'a option) -> 'a t -> 'a t - (** [update x f m] returns a map containing the same bindings as + @ocaml.doc(" [update x f m] returns a map containing the same bindings as [m], except for the binding of [x]. Depending on the value of [y] where [y] is [f (find_opt x m)], the binding of [x] is added, removed or updated. If [y] is [None], the binding is @@ -97,34 +95,33 @@ module type S = is returned unchanged (the result of the function is then physically equal to [m]). @since 4.06.0 - *) + ") + let update: (key, option<'a> => option<'a>, t<'a>) => t<'a> - val singleton: key -> 'a -> 'a t - (** [singleton x y] returns the one-element map that contains a binding [y] + @ocaml.doc(" [singleton x y] returns the one-element map that contains a binding [y] for [x]. @since 3.12.0 - *) + ") + let singleton: (key, 'a) => t<'a> - val remove: key -> 'a t -> 'a t - (** [remove x m] returns a map containing the same bindings as + @ocaml.doc(" [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. If [x] was not in [m], [m] is returned unchanged (the result of the function is then physically equal to [m]). - @before 4.03 Physical equality was not ensured. *) + @before 4.03 Physical equality was not ensured. ") + let remove: (key, t<'a>) => t<'a> - val merge: - (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - (** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] + @ocaml.doc(" [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] and of [m2]. The presence of each such binding, and the corresponding value, is determined with the function [f]. In terms of the [find_opt] operation, we have [find_opt x (merge f m1 m2) = f (find_opt x m1) (find_opt x m2)] for any key [x], provided that [f None None = None]. @since 3.12.0 - *) + ") + let merge: ((key, option<'a>, option<'b>) => option<'c>, t<'a>, t<'b>) => t<'c> - val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - (** [union f m1 m2] computes a map whose keys is the union of keys + @ocaml.doc(" [union f m1 m2] computes a map whose keys is the union of keys of [m1] and of [m2]. When the same binding is defined in both arguments, the function [f] is used to combine them. This is a special case of [merge]: [union f m1 m2] is equivalent @@ -135,113 +132,113 @@ module type S = - [f' (Some v1) (Some v2) = f v1 v2] @since 4.03.0 - *) + ") + let union: ((key, 'a, 'a) => option<'a>, t<'a>, t<'a>) => t<'a> - val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int - (** Total ordering between maps. The first argument is a total ordering - used to compare data associated with equal keys in the two maps. *) + @ocaml.doc(" Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. ") + let compare: (('a, 'a) => int, t<'a>, t<'a>) => int - val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are + @ocaml.doc(" [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare - the data associated with the keys. *) + the data associated with the keys. ") + let equal: (('a, 'a) => bool, t<'a>, t<'a>) => bool - val iter: (key -> 'a -> unit) -> 'a t -> unit - (** [iter f m] applies [f] to all bindings in map [m]. + @ocaml.doc(" [iter f m] applies [f] to all bindings in map [m]. [f] receives the key as first argument, and the associated value as second argument. The bindings are passed to [f] in increasing - order with respect to the ordering over the type of the keys. *) + order with respect to the ordering over the type of the keys. ") + let iter: ((key, 'a) => unit, t<'a>) => unit - val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b - (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + @ocaml.doc(" [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], where [k1 ... kN] are the keys of all bindings in [m] - (in increasing order), and [d1 ... dN] are the associated data. *) + (in increasing order), and [d1 ... dN] are the associated data. ") + let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b - val for_all: (key -> 'a -> bool) -> 'a t -> bool - (** [for_all p m] checks if all the bindings of the map + @ocaml.doc(" [for_all p m] checks if all the bindings of the map satisfy the predicate [p]. @since 3.12.0 - *) + ") + let for_all: ((key, 'a) => bool, t<'a>) => bool - val exists: (key -> 'a -> bool) -> 'a t -> bool - (** [exists p m] checks if at least one binding of the map + @ocaml.doc(" [exists p m] checks if at least one binding of the map satisfies the predicate [p]. @since 3.12.0 - *) + ") + let exists: ((key, 'a) => bool, t<'a>) => bool - val filter: (key -> 'a -> bool) -> 'a t -> 'a t - (** [filter p m] returns the map with all the bindings in [m] + @ocaml.doc(" [filter p m] returns the map with all the bindings in [m] that satisfy predicate [p]. If [p] satisfies every binding in [m], [m] is returned unchanged (the result of the function is then physically equal to [m]) @since 3.12.0 @before 4.03 Physical equality was not ensured. - *) + ") + let filter: ((key, 'a) => bool, t<'a>) => t<'a> - val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t - (** [partition p m] returns a pair of maps [(m1, m2)], where + @ocaml.doc(" [partition p m] returns a pair of maps [(m1, m2)], where [m1] contains all the bindings of [s] that satisfy the predicate [p], and [m2] is the map with all the bindings of [s] that do not satisfy [p]. @since 3.12.0 - *) + ") + let partition: ((key, 'a) => bool, t<'a>) => (t<'a>, t<'a>) - val cardinal: 'a t -> int - (** Return the number of bindings of a map. + @ocaml.doc(" Return the number of bindings of a map. @since 3.12.0 - *) + ") + let cardinal: t<'a> => int - val bindings: 'a t -> (key * 'a) list - (** Return the list of all bindings of the given map. + @ocaml.doc(" Return the list of all bindings of the given map. The returned list is sorted in increasing order with respect to the ordering [Ord.compare], where [Ord] is the argument given to {!Map.Make}. @since 3.12.0 - *) + ") + let bindings: t<'a> => list<(key, 'a)> - val min_binding: 'a t -> (key * 'a) - (** Return the smallest binding of the given map + @ocaml.doc(" Return the smallest binding of the given map (with respect to the [Ord.compare] ordering), or raise [Not_found] if the map is empty. @since 3.12.0 - *) + ") + let min_binding: t<'a> => (key, 'a) - val min_binding_opt: 'a t -> (key * 'a) option - (** Return the smallest binding of the given map + @ocaml.doc(" Return the smallest binding of the given map (with respect to the [Ord.compare] ordering), or [None] if the map is empty. @since 4.05 - *) + ") + let min_binding_opt: t<'a> => option<(key, 'a)> - val max_binding: 'a t -> (key * 'a) - (** Same as {!Map.S.min_binding}, but returns the largest binding + @ocaml.doc(" Same as {!Map.S.min_binding}, but returns the largest binding of the given map. @since 3.12.0 - *) + ") + let max_binding: t<'a> => (key, 'a) - val max_binding_opt: 'a t -> (key * 'a) option - (** Same as {!Map.S.min_binding_opt}, but returns the largest binding + @ocaml.doc(" Same as {!Map.S.min_binding_opt}, but returns the largest binding of the given map. @since 4.05 - *) + ") + let max_binding_opt: t<'a> => option<(key, 'a)> - val choose: 'a t -> (key * 'a) - (** Return one binding of the given map, or raise [Not_found] if + @ocaml.doc(" Return one binding of the given map, or raise [Not_found] if the map is empty. Which binding is chosen is unspecified, but equal bindings will be chosen for equal maps. @since 3.12.0 - *) + ") + let choose: t<'a> => (key, 'a) - val choose_opt: 'a t -> (key * 'a) option - (** Return one binding of the given map, or [None] if + @ocaml.doc(" Return one binding of the given map, or [None] if the map is empty. Which binding is chosen is unspecified, but equal bindings will be chosen for equal maps. @since 4.05 - *) + ") + let choose_opt: t<'a> => option<(key, 'a)> - val split: key -> 'a t -> 'a t * 'a option * 'a t - (** [split x m] returns a triple [(l, data, r)], where + @ocaml.doc(" [split x m] returns a triple [(l, data, r)], where [l] is the map with all the bindings of [m] whose key is strictly less than [x]; [r] is the map with all the bindings of [m] whose key @@ -249,20 +246,20 @@ module type S = [data] is [None] if [m] contains no binding for [x], or [Some v] if [m] binds [v] to [x]. @since 3.12.0 - *) + ") + let split: (key, t<'a>) => (t<'a>, option<'a>, t<'a>) - val find: key -> 'a t -> 'a - (** [find x m] returns the current binding of [x] in [m], - or raises [Not_found] if no such binding exists. *) + @ocaml.doc(" [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. ") + let find: (key, t<'a>) => 'a - val find_opt: key -> 'a t -> 'a option - (** [find_opt x m] returns [Some v] if the current binding of [x] + @ocaml.doc(" [find_opt x m] returns [Some v] if the current binding of [x] in [m] is [v], or [None] if no such binding exists. @since 4.05 - *) + ") + let find_opt: (key, t<'a>) => option<'a> - val find_first: (key -> bool) -> 'a t -> key * 'a - (** [find_first f m], where [f] is a monotonically increasing function, + @ocaml.doc(" [find_first f m], where [f] is a monotonically increasing function, returns the binding of [m] with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists. @@ -272,44 +269,42 @@ module type S = element of [m]. @since 4.05 - *) + ") + let find_first: (key => bool, t<'a>) => (key, 'a) - val find_first_opt: (key -> bool) -> 'a t -> (key * 'a) option - (** [find_first_opt f m], where [f] is a monotonically increasing function, + @ocaml.doc(" [find_first_opt f m], where [f] is a monotonically increasing function, returns an option containing the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists. @since 4.05 - *) + ") + let find_first_opt: (key => bool, t<'a>) => option<(key, 'a)> - val find_last: (key -> bool) -> 'a t -> key * 'a - (** [find_last f m], where [f] is a monotonically decreasing function, + @ocaml.doc(" [find_last f m], where [f] is a monotonically decreasing function, returns the binding of [m] with the highest key [k] such that [f k], or raises [Not_found] if no such key exists. @since 4.05 - *) + ") + let find_last: (key => bool, t<'a>) => (key, 'a) - val find_last_opt: (key -> bool) -> 'a t -> (key * 'a) option - (** [find_last_opt f m], where [f] is a monotonically decreasing function, + @ocaml.doc(" [find_last_opt f m], where [f] is a monotonically decreasing function, returns an option containing the binding of [m] with the highest key [k] such that [f k], or [None] if no such key exists. @since 4.05 - *) + ") + let find_last_opt: (key => bool, t<'a>) => option<(key, 'a)> - val map: ('a -> 'b) -> 'a t -> 'b t - (** [map f m] returns a map with same domain as [m], where the + @ocaml.doc(" [map f m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been replaced by the result of the application of [f] to [a]. The bindings are passed to [f] in increasing order - with respect to the ordering over the type of the keys. *) + with respect to the ordering over the type of the keys. ") + let map: ('a => 'b, t<'a>) => t<'b> - val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t - (** Same as {!Map.S.map}, but the function receives as arguments both the - key and the associated value for each binding of the map. *) + @ocaml.doc(" Same as {!Map.S.map}, but the function receives as arguments both the + key and the associated value for each binding of the map. ") + let mapi: ((key, 'a) => 'b, t<'a>) => t<'b> +} - - end -(** Output signature of the functor {!Map.Make}. *) - -module Make (Ord : OrderedType) : S with type key = Ord.t -(** Functor building an implementation of the map structure - given a totally ordered type. *) +@ocaml.doc(" Functor building an implementation of the map structure + given a totally ordered type. ") +module Make: (Ord: OrderedType) => (S with type key = Ord.t) diff --git a/jscomp/stdlib-406/mapLabels.ml b/jscomp/stdlib-406/mapLabels.ml deleted file mode 100644 index 1c59131637..0000000000 --- a/jscomp/stdlib-406/mapLabels.ml +++ /dev/null @@ -1,480 +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. *) -(* *) -(**************************************************************************) - -module type OrderedType = - sig - type t - val compare: t -> t -> int - end - -module type S = - sig - type key - type +'a t - val empty: 'a t - val is_empty: 'a t -> bool - val mem: key -> 'a t -> bool - val add: key:key -> data:'a -> 'a t -> 'a t - val update: key:key -> f:('a option -> 'a option) -> 'a t -> 'a t - val singleton: key -> 'a -> 'a t - val remove: key -> 'a t -> 'a t - val merge: - f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union: f:(key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter: f:(key:key -> data:'a -> unit) -> 'a t -> unit - val fold: f:(key:key -> data:'a -> 'b -> 'b) -> 'a t -> init:'b -> 'b - val for_all: f:(key -> 'a -> bool) -> 'a t -> bool - val exists: f:(key -> 'a -> bool) -> 'a t -> bool - val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t - val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val cardinal: 'a t -> int - val bindings: 'a t -> (key * 'a) list - val min_binding: 'a t -> (key * 'a) - val min_binding_opt: 'a t -> (key * 'a) option - val max_binding: 'a t -> (key * 'a) - val max_binding_opt: 'a t -> (key * 'a) option - val choose: 'a t -> (key * 'a) - val choose_opt: 'a t -> (key * 'a) option - val split: key -> 'a t -> 'a t * 'a option * 'a t - val find: key -> 'a t -> 'a - val find_opt: key -> 'a t -> 'a option - val find_first: f:(key -> bool) -> 'a t -> key * 'a - val find_first_opt: f:(key -> bool) -> 'a t -> (key * 'a) option - val find_last: f:(key -> bool) -> 'a t -> key * 'a - val find_last_opt: f:(key -> bool) -> 'a t -> (key * 'a) option - val map: f:('a -> 'b) -> 'a t -> 'b t - val mapi: f:(key -> 'a -> 'b) -> 'a t -> 'b t - end - -module Make(Ord: OrderedType) = struct - - type key = Ord.t - - type 'a t = - Empty - | Node of {l:'a t; v:key; d:'a; r:'a t; h:int} - - let height = function - Empty -> 0 - | Node {h} -> h - - let create l x d r = - let hl = height l and hr = height r in - Node{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - let singleton x d = Node{l=Empty; v=x; d; r=Empty; h=1} - - let bal l x d r = - let hl = match l with Empty -> 0 | Node {h} -> h in - let hr = match r with Empty -> 0 | Node {h} -> h in - if hl > hr + 2 then begin - match l with - Empty -> invalid_arg "Map.bal" - | Node{l=ll; v=lv; d=ld; r=lr} -> - if height ll >= height lr then - create ll lv ld (create lr x d r) - else begin - match lr with - Empty -> invalid_arg "Map.bal" - | Node{l=lrl; v=lrv; d=lrd; r=lrr}-> - create (create ll lv ld lrl) lrv lrd (create lrr x d r) - end - end else if hr > hl + 2 then begin - match r with - Empty -> invalid_arg "Map.bal" - | Node{l=rl; v=rv; d=rd; r=rr} -> - if height rr >= height rl then - create (create l x d rl) rv rd rr - else begin - match rl with - Empty -> invalid_arg "Map.bal" - | Node{l=rll; v=rlv; d=rld; r=rlr} -> - create (create l x d rll) rlv rld (create rlr rv rd rr) - end - end else - Node{l; v=x; d; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - let empty = Empty - - let is_empty = function Empty -> true | _ -> false - - let rec add ~key:x ~data = function - Empty -> - Node{l=Empty; v=x; d=data; r=Empty; h=1} - | Node {l; v; d; r; h} as m -> - let c = Ord.compare x v in - if c = 0 then - if d == data then m else Node{l; v=x; d=data; r; h} - else if c < 0 then - let ll = add ~key:x ~data l in - if l == ll then m else bal ll v d r - else - let rr = add ~key:x ~data r in - if r == rr then m else bal l v d rr - - let rec find x = function - Empty -> - raise Not_found - | Node {l; v; d; r} -> - let c = Ord.compare x v in - if c = 0 then d - else find x (if c < 0 then l else r) - - let rec find_first_aux v0 d0 f = function - Empty -> - (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_first_aux v d f l - else - find_first_aux v0 d0 f r - - let rec find_first ~f = function - Empty -> - raise Not_found - | Node {l; v; d; r} -> - if f v then - find_first_aux v d f l - else - find_first ~f r - - let rec find_first_opt_aux v0 d0 f = function - Empty -> - Some (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_first_opt_aux v d f l - else - find_first_opt_aux v0 d0 f r - - let rec find_first_opt ~f = function - Empty -> - None - | Node {l; v; d; r} -> - if f v then - find_first_opt_aux v d f l - else - find_first_opt ~f r - - let rec find_last_aux v0 d0 f = function - Empty -> - (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_last_aux v d f r - else - find_last_aux v0 d0 f l - - let rec find_last ~f = function - Empty -> - raise Not_found - | Node {l; v; d; r} -> - if f v then - find_last_aux v d f r - else - find_last ~f l - - let rec find_last_opt_aux v0 d0 f = function - Empty -> - Some (v0, d0) - | Node {l; v; d; r} -> - if f v then - find_last_opt_aux v d f r - else - find_last_opt_aux v0 d0 f l - - let rec find_last_opt ~f = function - Empty -> - None - | Node {l; v; d; r} -> - if f v then - find_last_opt_aux v d f r - else - find_last_opt ~f l - - let rec find_opt x = function - Empty -> - None - | Node {l; v; d; r} -> - let c = Ord.compare x v in - if c = 0 then Some d - else find_opt x (if c < 0 then l else r) - - let rec mem x = function - Empty -> - false - | Node {l; v; r} -> - let c = Ord.compare x v in - c = 0 || mem x (if c < 0 then l else r) - - let rec min_binding = function - Empty -> raise Not_found - | Node {l=Empty; v; d} -> (v, d) - | Node {l} -> min_binding l - - let rec min_binding_opt = function - Empty -> None - | Node {l=Empty; v; d} -> Some (v, d) - | Node {l}-> min_binding_opt l - - let rec max_binding = function - Empty -> raise Not_found - | Node {v; d; r=Empty} -> (v, d) - | Node {r} -> max_binding r - - let rec max_binding_opt = function - Empty -> None - | Node {v; d; r=Empty} -> Some (v, d) - | Node {r} -> max_binding_opt r - - let rec remove_min_binding = function - Empty -> invalid_arg "Map.remove_min_elt" - | Node {l=Empty; r} -> r - | Node {l; v; d; r} -> bal (remove_min_binding l) v d r - - let merge t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> - let (x, d) = min_binding t2 in - bal t1 x d (remove_min_binding t2) - - let rec remove x = function - Empty -> - Empty - | (Node {l; v; d; r} as m) -> - let c = Ord.compare x v in - if c = 0 then merge l r - else if c < 0 then - let ll = remove x l in if l == ll then m else bal ll v d r - else - let rr = remove x r in if r == rr then m else bal l v d rr - - let rec update ~key:x ~f = function - Empty -> - begin match f None with - | None -> Empty - | Some data -> Node{l=Empty; v=x; d=data; r=Empty; h=1} - end - | Node {l; v; d; r; h} as m -> - let c = Ord.compare x v in - if c = 0 then begin - match f (Some d) with - | None -> merge l r - | Some data -> - if d == data then m else Node{l; v=x; d=data; r; h} - end else if c < 0 then - let ll = update ~key:x ~f l in - if l == ll then m else bal ll v d r - else - let rr = update ~key:x ~f r in - if r == rr then m else bal l v d rr - - let rec iter ~f = function - Empty -> () - | Node {l; v; d; r} -> - iter ~f l; f ~key:v ~data:d; iter ~f r - - let rec map ~f = function - Empty -> - Empty - | Node {l; v; d; r; h} -> - let l' = map ~f l in - let d' = f d in - let r' = map ~f r in - Node{l=l'; v; d=d'; r=r'; h} - - let rec mapi ~f = function - Empty -> - Empty - | Node {l; v; d; r; h} -> - let l' = mapi ~f l in - let d' = f v d in - let r' = mapi ~f r in - Node{l=l'; v; d=d'; r=r'; h} - - let rec fold ~f m ~init:accu = - match m with - Empty -> accu - | Node {l; v; d; r} -> - fold ~f r ~init:(f ~key:v ~data:d (fold ~f l ~init:accu)) - - let rec for_all ~f:p = function - Empty -> true - | Node {l; v; d; r} -> p v d && for_all ~f:p l && for_all ~f:p r - - let rec exists ~f:p = function - Empty -> false - | Node {l; v; d; r} -> p v d || exists ~f:p l || exists ~f:p r - - (* Beware: those two functions assume that the added k is *strictly* - smaller (or bigger) than all the present keys in the tree; it - does not test for equality with the current min (or max) key. - - Indeed, they are only used during the "join" operation which - respects this precondition. - *) - - let rec add_min_binding k x = function - | Empty -> singleton k x - | Node {l; v; d; r} -> - bal (add_min_binding k x l) v d r - - let rec add_max_binding k x = function - | Empty -> singleton k x - | Node {l; v; d; r} -> - bal l v d (add_max_binding k x r) - - (* Same as create and bal, but no assumptions are made on the - relative heights of l and r. *) - - let rec join l v d r = - match (l, r) with - (Empty, _) -> add_min_binding v d r - | (_, Empty) -> add_max_binding v d l - | (Node{l=ll; v=lv; d=ld; r=lr; h=lh}, Node{l=rl; v=rv; d=rd; r=rr; h=rh}) -> - if lh > rh + 2 then bal ll lv ld (join lr v d r) else - if rh > lh + 2 then bal (join l v d rl) rv rd rr else - create l v d r - - (* Merge two trees l and r into one. - All elements of l must precede the elements of r. - No assumption on the heights of l and r. *) - - let concat t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> - let (x, d) = min_binding t2 in - join t1 x d (remove_min_binding t2) - - let concat_or_join t1 v d t2 = - match d with - | Some d -> join t1 v d t2 - | None -> concat t1 t2 - - let rec split x = function - Empty -> - (Empty, None, Empty) - | Node {l; v; d; r} -> - let c = Ord.compare x v in - if c = 0 then (l, Some d, r) - else if c < 0 then - let (ll, pres, rl) = split x l in (ll, pres, join rl v d r) - else - let (lr, pres, rr) = split x r in (join l v d lr, pres, rr) - - let rec merge ~f s1 s2 = - match (s1, s2) with - (Empty, Empty) -> Empty - | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, _) when h1 >= height s2 -> - let (l2, d2, r2) = split v1 s2 in - concat_or_join (merge ~f l1 l2) v1 (f v1 (Some d1) d2) (merge ~f r1 r2) - | (_, Node {l=l2; v=v2; d=d2; r=r2}) -> - let (l1, d1, r1) = split v2 s1 in - concat_or_join (merge ~f l1 l2) v2 (f v2 d1 (Some d2)) (merge ~f r1 r2) - | _ -> - assert false - - let rec union ~f s1 s2 = - match (s1, s2) with - | (Empty, s) | (s, Empty) -> s - | (Node {l=l1; v=v1; d=d1; r=r1; h=h1}, Node {l=l2; v=v2; d=d2; r=r2; h=h2}) -> - if h1 >= h2 then - let (l2, d2, r2) = split v1 s2 in - let l = union ~f l1 l2 and r = union ~f r1 r2 in - match d2 with - | None -> join l v1 d1 r - | Some d2 -> concat_or_join l v1 (f v1 d1 d2) r - else - let (l1, d1, r1) = split v2 s1 in - let l = union ~f l1 l2 and r = union ~f r1 r2 in - match d1 with - | None -> join l v2 d2 r - | Some d1 -> concat_or_join l v2 (f v2 d1 d2) r - - let rec filter ~f:p = function - Empty -> Empty - | Node {l; v; d; r} as m -> - (* call [p] in the expected left-to-right order *) - let l' = filter ~f:p l in - let pvd = p v d in - let r' = filter ~f:p r in - if pvd then if l==l' && r==r' then m else join l' v d r' - else concat l' r' - - let rec partition ~f:p = function - Empty -> (Empty, Empty) - | Node {l; v; d; r} -> - (* call [p] in the expected left-to-right order *) - let (lt, lf) = partition ~f:p l in - let pvd = p v d in - let (rt, rf) = partition ~f:p r in - if pvd - then (join lt v d rt, concat lf rf) - else (concat lt rt, join lf v d rf) - - type 'a enumeration = End | More of key * 'a * 'a t * 'a enumeration - - let rec cons_enum m e = - match m with - Empty -> e - | Node {l; v; d; r} -> cons_enum l (More(v, d, r, e)) - - let compare ~cmp m1 m2 = - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 then c else - let c = cmp d1 d2 in - if c <> 0 then c else - compare_aux (cons_enum r1 e1) (cons_enum r2 e2) - in compare_aux (cons_enum m1 End) (cons_enum m2 End) - - let equal ~cmp m1 m2 = - let rec equal_aux e1 e2 = - match (e1, e2) with - (End, End) -> true - | (End, _) -> false - | (_, End) -> false - | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) -> - Ord.compare v1 v2 = 0 && cmp d1 d2 && - equal_aux (cons_enum r1 e1) (cons_enum r2 e2) - in equal_aux (cons_enum m1 End) (cons_enum m2 End) - - let rec cardinal = function - Empty -> 0 - | Node {l; r} -> cardinal l + 1 + cardinal r - - let rec bindings_aux accu = function - Empty -> accu - | Node {l; v; d; r} -> bindings_aux ((v, d) :: bindings_aux accu r) l - - let bindings s = - bindings_aux [] s - - let choose = min_binding - - let choose_opt = min_binding_opt - -end diff --git a/jscomp/stdlib-406/mapLabels.res b/jscomp/stdlib-406/mapLabels.res new file mode 100644 index 0000000000..7a1a395075 --- /dev/null +++ b/jscomp/stdlib-406/mapLabels.res @@ -0,0 +1,669 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +module type OrderedType = { + type t + let compare: (t, t) => int +} + +module type S = { + type key + type 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) => { + type key = Ord.t + + type rec t<'a> = + | Empty + | Node({l: t<'a>, v: key, d: 'a, r: t<'a>, h: int}) + + let height = param => + switch param { + | Empty => 0 + | Node({h}) => h + } + + let create = (l, x, d, r) => { + let hl = height(l) and hr = height(r) + Node({ + l, + v: x, + d, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + + let singleton = (x, d) => Node({l: Empty, v: x, d, r: Empty, h: 1}) + + let bal = (l, x, d, r) => { + let hl = switch l { + | Empty => 0 + | Node({h}) => h + } + let hr = switch r { + | Empty => 0 + | Node({h}) => h + } + if hl > hr + 2 { + switch l { + | Empty => invalid_arg("Map.bal") + | Node({l: ll, v: lv, d: ld, r: lr}) => + if height(ll) >= height(lr) { + create(ll, lv, ld, create(lr, x, d, r)) + } else { + switch lr { + | Empty => invalid_arg("Map.bal") + | Node({l: lrl, v: lrv, d: lrd, r: lrr}) => + create(create(ll, lv, ld, lrl), lrv, lrd, create(lrr, x, d, r)) + } + } + } + } else if hr > hl + 2 { + switch r { + | Empty => invalid_arg("Map.bal") + | Node({l: rl, v: rv, d: rd, r: rr}) => + if height(rr) >= height(rl) { + create(create(l, x, d, rl), rv, rd, rr) + } else { + switch rl { + | Empty => invalid_arg("Map.bal") + | Node({l: rll, v: rlv, d: rld, r: rlr}) => + create(create(l, x, d, rll), rlv, rld, create(rlr, rv, rd, rr)) + } + } + } + } else { + Node({ + l, + v: x, + d, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + } + + let empty = Empty + + let is_empty = param => + switch param { + | Empty => true + | _ => false + } + + let rec add = (~key as x, ~data, param) => + switch param { + | Empty => Node({l: Empty, v: x, d: data, r: Empty, h: 1}) + | Node({l, v, d, r, h}) as m => + let c = Ord.compare(x, v) + if c == 0 { + if d === data { + m + } else { + Node({l, v: x, d: data, r, h}) + } + } else if c < 0 { + let ll = add(~key=x, ~data, l) + if l === ll { + m + } else { + bal(ll, v, d, r) + } + } else { + let rr = add(~key=x, ~data, r) + if r === rr { + m + } else { + bal(l, v, d, rr) + } + } + } + + let rec find = (x, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, d, r}) => + let c = Ord.compare(x, v) + if c == 0 { + d + } else { + find( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let rec find_first_aux = (v0, d0, f, param) => + switch param { + | Empty => (v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_first_aux(v, d, f, l) + } else { + find_first_aux(v0, d0, f, r) + } + } + + let rec find_first = (~f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, d, r}) => + if f(v) { + find_first_aux(v, d, f, l) + } else { + find_first(~f, r) + } + } + + let rec find_first_opt_aux = (v0, d0, f, param) => + switch param { + | Empty => Some(v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_first_opt_aux(v, d, f, l) + } else { + find_first_opt_aux(v0, d0, f, r) + } + } + + let rec find_first_opt = (~f, param) => + switch param { + | Empty => None + | Node({l, v, d, r}) => + if f(v) { + find_first_opt_aux(v, d, f, l) + } else { + find_first_opt(~f, r) + } + } + + let rec find_last_aux = (v0, d0, f, param) => + switch param { + | Empty => (v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_last_aux(v, d, f, r) + } else { + find_last_aux(v0, d0, f, l) + } + } + + let rec find_last = (~f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, d, r}) => + if f(v) { + find_last_aux(v, d, f, r) + } else { + find_last(~f, l) + } + } + + let rec find_last_opt_aux = (v0, d0, f, param) => + switch param { + | Empty => Some(v0, d0) + | Node({l, v, d, r}) => + if f(v) { + find_last_opt_aux(v, d, f, r) + } else { + find_last_opt_aux(v0, d0, f, l) + } + } + + let rec find_last_opt = (~f, param) => + switch param { + | Empty => None + | Node({l, v, d, r}) => + if f(v) { + find_last_opt_aux(v, d, f, r) + } else { + find_last_opt(~f, l) + } + } + + let rec find_opt = (x, param) => + switch param { + | Empty => None + | Node({l, v, d, r}) => + let c = Ord.compare(x, v) + if c == 0 { + Some(d) + } else { + find_opt( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let rec mem = (x, param) => + switch param { + | Empty => false + | Node({l, v, r}) => + let c = Ord.compare(x, v) + c == 0 || + mem( + x, + if c < 0 { + l + } else { + r + }, + ) + } + + let rec min_binding = param => + switch param { + | Empty => raise(Not_found) + | Node({l: Empty, v, d}) => (v, d) + | Node({l}) => min_binding(l) + } + + let rec min_binding_opt = param => + switch param { + | Empty => None + | Node({l: Empty, v, d}) => Some(v, d) + | Node({l}) => min_binding_opt(l) + } + + let rec max_binding = param => + switch param { + | Empty => raise(Not_found) + | Node({v, d, r: Empty}) => (v, d) + | Node({r}) => max_binding(r) + } + + let rec max_binding_opt = param => + switch param { + | Empty => None + | Node({v, d, r: Empty}) => Some(v, d) + | Node({r}) => max_binding_opt(r) + } + + let rec remove_min_binding = param => + switch param { + | Empty => invalid_arg("Map.remove_min_elt") + | Node({l: Empty, r}) => r + | Node({l, v, d, r}) => bal(remove_min_binding(l), v, d, r) + } + + let merge = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => + let (x, d) = min_binding(t2) + bal(t1, x, d, remove_min_binding(t2)) + } + + let rec remove = (x, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r}) as m => + let c = Ord.compare(x, v) + if c == 0 { + merge(l, r) + } else if c < 0 { + let ll = remove(x, l) + if l === ll { + m + } else { + bal(ll, v, d, r) + } + } else { + let rr = remove(x, r) + if r === rr { + m + } else { + bal(l, v, d, rr) + } + } + } + + let rec update = (~key as x, ~f, param) => + switch param { + | Empty => + switch f(None) { + | None => Empty + | Some(data) => Node({l: Empty, v: x, d: data, r: Empty, h: 1}) + } + | Node({l, v, d, r, h}) as m => + let c = Ord.compare(x, v) + if c == 0 { + switch f(Some(d)) { + | None => merge(l, r) + | Some(data) => + if d === data { + m + } else { + Node({l, v: x, d: data, r, h}) + } + } + } else if c < 0 { + let ll = update(~key=x, ~f, l) + if l === ll { + m + } else { + bal(ll, v, d, r) + } + } else { + let rr = update(~key=x, ~f, r) + if r === rr { + m + } else { + bal(l, v, d, rr) + } + } + } + + let rec iter = (~f, param) => + switch param { + | Empty => () + | Node({l, v, d, r}) => + iter(~f, l) + f(~key=v, ~data=d) + iter(~f, r) + } + + let rec map = (~f, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r, h}) => + let l' = map(~f, l) + let d' = f(d) + let r' = map(~f, r) + Node({l: l', v, d: d', r: r', h}) + } + + let rec mapi = (~f, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r, h}) => + let l' = mapi(~f, l) + let d' = f(v, d) + let r' = mapi(~f, r) + Node({l: l', v, d: d', r: r', h}) + } + + let rec fold = (~f, m, ~init as accu) => + switch m { + | Empty => accu + | Node({l, v, d, r}) => fold(~f, r, ~init=f(~key=v, ~data=d, fold(~f, l, ~init=accu))) + } + + let rec for_all = (~f as p, param) => + switch param { + | Empty => true + | Node({l, v, d, r}) => p(v, d) && (for_all(~f=p, l) && for_all(~f=p, r)) + } + + let rec exists = (~f as p, param) => + switch param { + | Empty => false + | Node({l, v, d, r}) => p(v, d) || (exists(~f=p, l) || exists(~f=p, r)) + } + + /* Beware: those two functions assume that the added k is *strictly* + smaller (or bigger) than all the present keys in the tree; it + does not test for equality with the current min (or max) key. + + Indeed, they are only used during the "join" operation which + respects this precondition. + */ + + let rec add_min_binding = (k, x, param) => + switch param { + | Empty => singleton(k, x) + | Node({l, v, d, r}) => bal(add_min_binding(k, x, l), v, d, r) + } + + let rec add_max_binding = (k, x, param) => + switch param { + | Empty => singleton(k, x) + | Node({l, v, d, r}) => bal(l, v, d, add_max_binding(k, x, r)) + } + + /* Same as create and bal, but no assumptions are made on the + relative heights of l and r. */ + + let rec join = (l, v, d, r) => + switch (l, r) { + | (Empty, _) => add_min_binding(v, d, r) + | (_, Empty) => add_max_binding(v, d, l) + | (Node({l: ll, v: lv, d: ld, r: lr, h: lh}), Node({l: rl, v: rv, d: rd, r: rr, h: rh})) => + if lh > rh + 2 { + bal(ll, lv, ld, join(lr, v, d, r)) + } else if rh > lh + 2 { + bal(join(l, v, d, rl), rv, rd, rr) + } else { + create(l, v, d, r) + } + } + + /* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. */ + + let concat = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => + let (x, d) = min_binding(t2) + join(t1, x, d, remove_min_binding(t2)) + } + + let concat_or_join = (t1, v, d, t2) => + switch d { + | Some(d) => join(t1, v, d, t2) + | None => concat(t1, t2) + } + + let rec split = (x, param) => + switch param { + | Empty => (Empty, None, Empty) + | Node({l, v, d, r}) => + let c = Ord.compare(x, v) + if c == 0 { + (l, Some(d), r) + } else if c < 0 { + let (ll, pres, rl) = split(x, l) + (ll, pres, join(rl, v, d, r)) + } else { + let (lr, pres, rr) = split(x, r) + (join(l, v, d, lr), pres, rr) + } + } + + let rec merge = (~f, s1, s2) => + switch (s1, s2) { + | (Empty, Empty) => Empty + | (Node({l: l1, v: v1, d: d1, r: r1, h: h1}), _) if h1 >= height(s2) => + let (l2, d2, r2) = split(v1, s2) + concat_or_join(merge(~f, l1, l2), v1, f(v1, Some(d1), d2), merge(~f, r1, r2)) + | (_, Node({l: l2, v: v2, d: d2, r: r2})) => + let (l1, d1, r1) = split(v2, s1) + concat_or_join(merge(~f, l1, l2), v2, f(v2, d1, Some(d2)), merge(~f, r1, r2)) + | _ => assert(false) + } + + let rec union = (~f, s1, s2) => + switch (s1, s2) { + | (Empty, s) | (s, Empty) => s + | (Node({l: l1, v: v1, d: d1, r: r1, h: h1}), Node({l: l2, v: v2, d: d2, r: r2, h: h2})) => + if h1 >= h2 { + let (l2, d2, r2) = split(v1, s2) + let l = union(~f, l1, l2) and r = union(~f, r1, r2) + switch d2 { + | None => join(l, v1, d1, r) + | Some(d2) => concat_or_join(l, v1, f(v1, d1, d2), r) + } + } else { + let (l1, d1, r1) = split(v2, s1) + let l = union(~f, l1, l2) and r = union(~f, r1, r2) + switch d1 { + | None => join(l, v2, d2, r) + | Some(d1) => concat_or_join(l, v2, f(v2, d1, d2), r) + } + } + } + + let rec filter = (~f as p, param) => + switch param { + | Empty => Empty + | Node({l, v, d, r}) as m => + /* call [p] in the expected left-to-right order */ + let l' = filter(~f=p, l) + let pvd = p(v, d) + let r' = filter(~f=p, r) + if pvd { + if l === l' && r === r' { + m + } else { + join(l', v, d, r') + } + } else { + concat(l', r') + } + } + + let rec partition = (~f as p, param) => + switch param { + | Empty => (Empty, Empty) + | Node({l, v, d, r}) => + /* call [p] in the expected left-to-right order */ + let (lt, lf) = partition(~f=p, l) + let pvd = p(v, d) + let (rt, rf) = partition(~f=p, r) + if pvd { + (join(lt, v, d, rt), concat(lf, rf)) + } else { + (concat(lt, rt), join(lf, v, d, rf)) + } + } + + type rec enumeration<'a> = End | More(key, 'a, t<'a>, enumeration<'a>) + + let rec cons_enum = (m, e) => + switch m { + | Empty => e + | Node({l, v, d, r}) => cons_enum(l, More(v, d, r, e)) + } + + let compare = (~cmp, m1, m2) => { + let rec compare_aux = (e1, e2) => + switch (e1, e2) { + | (End, End) => 0 + | (End, _) => -1 + | (_, End) => 1 + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) => + let c = Ord.compare(v1, v2) + if c != 0 { + c + } else { + let c = cmp(d1, d2) + if c != 0 { + c + } else { + compare_aux(cons_enum(r1, e1), cons_enum(r2, e2)) + } + } + } + compare_aux(cons_enum(m1, End), cons_enum(m2, End)) + } + + let equal = (~cmp, m1, m2) => { + let rec equal_aux = (e1, e2) => + switch (e1, e2) { + | (End, End) => true + | (End, _) => false + | (_, End) => false + | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) => + Ord.compare(v1, v2) == 0 && (cmp(d1, d2) && equal_aux(cons_enum(r1, e1), cons_enum(r2, e2))) + } + equal_aux(cons_enum(m1, End), cons_enum(m2, End)) + } + + let rec cardinal = param => + switch param { + | Empty => 0 + | Node({l, r}) => cardinal(l) + 1 + cardinal(r) + } + + let rec bindings_aux = (accu, param) => + switch param { + | Empty => accu + | Node({l, v, d, r}) => bindings_aux(list{(v, d), ...bindings_aux(accu, r)}, l) + } + + let bindings = s => bindings_aux(list{}, s) + + let choose = min_binding + + let choose_opt = min_binding_opt +} diff --git a/jscomp/stdlib-406/moreLabels.ml b/jscomp/stdlib-406/moreLabels.ml deleted file mode 100644 index e4cee4a4ab..0000000000 --- a/jscomp/stdlib-406/moreLabels.ml +++ /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.mli b/jscomp/stdlib-406/moreLabels.mli deleted file mode 100644 index 95efcf8c80..0000000000 --- a/jscomp/stdlib-406/moreLabels.mli +++ /dev/null @@ -1,198 +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 : sig - type ('a, 'b) t = ('a, 'b) Hashtbl.t - val create : ?random:bool -> int -> ('a, 'b) t - val clear : ('a, 'b) t -> unit - val reset : ('a, 'b) t -> unit - val copy : ('a, 'b) t -> ('a, 'b) t - val add : ('a, 'b) t -> key:'a -> data:'b -> unit - val find : ('a, 'b) t -> 'a -> 'b - val find_opt : ('a, 'b) t -> 'a -> 'b option - val find_all : ('a, 'b) t -> 'a -> 'b list - val mem : ('a, 'b) t -> 'a -> bool - val remove : ('a, 'b) t -> 'a -> unit - val replace : ('a, 'b) t -> key:'a -> data:'b -> unit - val iter : f:(key:'a -> data:'b -> unit) -> ('a, 'b) t -> unit - val filter_map_inplace: - f:(key:'a -> data:'b -> 'b option) -> ('a, 'b) t -> unit - val fold : - f:(key:'a -> data:'b -> 'c -> 'c) -> - ('a, 'b) t -> init:'c -> 'c - val length : ('a, 'b) t -> int - val randomize : unit -> unit - val is_randomized : unit -> bool - type statistics = Hashtbl.statistics - val stats : ('a, 'b) t -> statistics - module type HashedType = Hashtbl.HashedType - module type SeededHashedType = Hashtbl.SeededHashedType - module type S = - sig - type key - and 'a t - val create : int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy : 'a t -> 'a t - val add : 'a t -> key:key -> data:'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt: 'a t -> key -> 'a option - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key:key -> data:'a -> unit - val mem : 'a t -> key -> bool - val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit - val filter_map_inplace: - f:(key:key -> data:'a -> 'a option) -> 'a t -> unit - val fold : - f:(key:key -> data:'a -> 'b -> 'b) -> - 'a t -> init:'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics - end - module type SeededS = - sig - type key - and 'a t - val create : ?random:bool -> int -> 'a t - val clear : 'a t -> unit - val reset : 'a t -> unit - val copy : 'a t -> 'a t - val add : 'a t -> key:key -> data:'a -> unit - val remove : 'a t -> key -> unit - val find : 'a t -> key -> 'a - val find_opt : 'a t -> key -> 'a option - val find_all : 'a t -> key -> 'a list - val replace : 'a t -> key:key -> data:'a -> unit - val mem : 'a t -> key -> bool - val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit - val filter_map_inplace: - f:(key:key -> data:'a -> 'a option) -> 'a t -> unit - val fold : - f:(key:key -> data:'a -> 'b -> 'b) -> - 'a t -> init:'b -> 'b - val length : 'a t -> int - val stats: 'a t -> statistics - end - module Make : functor (H : HashedType) -> S with type key = H.t - module MakeSeeded (H : SeededHashedType) : SeededS with type key = H.t - val hash : 'a -> int - val seeded_hash : int -> 'a -> int - val hash_param : int -> int -> 'a -> int - val seeded_hash_param : int -> int -> int -> 'a -> int -end - -module Map : sig - module type OrderedType = Map.OrderedType - module type S = - sig - type key - and (+'a) t - val empty : 'a t - val is_empty: 'a t -> bool - val mem : key -> 'a t -> bool - val add : key:key -> data:'a -> 'a t -> 'a t - val update: key:key -> f:('a option -> 'a option) -> 'a t -> 'a t - val singleton: key -> 'a -> 'a t - val remove : key -> 'a t -> 'a t - val merge: - f:(key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t - val union: f:(key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t - val compare: cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal: cmp:('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val iter : f:(key:key -> data:'a -> unit) -> 'a t -> unit - val fold : - f:(key:key -> data:'a -> 'b -> 'b) -> - 'a t -> init:'b -> 'b - val for_all: f:(key -> 'a -> bool) -> 'a t -> bool - val exists: f:(key -> 'a -> bool) -> 'a t -> bool - val filter: f:(key -> 'a -> bool) -> 'a t -> 'a t - val partition: f:(key -> 'a -> bool) -> 'a t -> 'a t * 'a t - val cardinal: 'a t -> int - val bindings: 'a t -> (key * 'a) list - val min_binding: 'a t -> (key * 'a) - val min_binding_opt: 'a t -> (key * 'a) option - val max_binding: 'a t -> (key * 'a) - val max_binding_opt: 'a t -> (key * 'a) option - val choose: 'a t -> (key * 'a) - val choose_opt: 'a t -> (key * 'a) option - val split: key -> 'a t -> 'a t * 'a option * 'a t - val find : key -> 'a t -> 'a - val find_opt: key -> 'a t -> 'a option - val find_first : f:(key -> bool) -> 'a t -> key * 'a - val find_first_opt : f:(key -> bool) -> 'a t -> (key * 'a) option - val find_last : f:(key -> bool) -> 'a t -> key * 'a - val find_last_opt : f:(key -> bool) -> 'a t -> (key * 'a) option - val map : f:('a -> 'b) -> 'a t -> 'b t - val mapi : f:(key -> 'a -> 'b) -> 'a t -> 'b t - end - module Make : functor (Ord : OrderedType) -> S with type key = Ord.t -end - -module Set : sig - module type OrderedType = Set.OrderedType - module type S = - sig - type elt - and t - val empty : t - val is_empty : t -> bool - val mem : elt -> t -> bool - val add : elt -> t -> t - val singleton : elt -> t - val remove : elt -> t -> t - val union : t -> t -> t - val inter : t -> t -> t - val diff : t -> t -> t - val compare : t -> t -> int - val equal : t -> t -> bool - val subset : t -> t -> bool - val iter : f:(elt -> unit) -> t -> unit - val map : f:(elt -> elt) -> t -> t - val fold : f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a - val for_all : f:(elt -> bool) -> t -> bool - val exists : f:(elt -> bool) -> t -> bool - val filter : f:(elt -> bool) -> t -> t - val partition : f:(elt -> bool) -> t -> t * t - val cardinal : t -> int - val elements : t -> elt list - val min_elt : t -> elt - val min_elt_opt: t -> elt option - val max_elt : t -> elt - val max_elt_opt: t -> elt option - val choose : t -> elt - val choose_opt: t -> elt option - val split: elt -> t -> t * bool * t - val find: elt -> t -> elt - val find_opt: elt -> t -> elt option - val find_first: f:(elt -> bool) -> t -> elt - val find_first_opt: f:(elt -> bool) -> t -> elt option - val find_last: f:(elt -> bool) -> t -> elt - val find_last_opt: f:(elt -> bool) -> t -> elt option - val of_list: elt list -> t - end - module Make : functor (Ord : OrderedType) -> S with type elt = Ord.t -end diff --git a/jscomp/stdlib-406/moreLabels.res b/jscomp/stdlib-406/moreLabels.res new file mode 100644 index 0000000000..2fb9e46e70 --- /dev/null +++ b/jscomp/stdlib-406/moreLabels.res @@ -0,0 +1,22 @@ +/* ************************************************************************ */ +/* */ +/* 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 new file mode 100644 index 0000000000..a93e011b3e --- /dev/null +++ b/jscomp/stdlib-406/moreLabels.resi @@ -0,0 +1,182 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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/obj.ml b/jscomp/stdlib-406/obj.ml deleted file mode 100644 index e746a90132..0000000000 --- a/jscomp/stdlib-406/obj.ml +++ /dev/null @@ -1,29 +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. *) -(* *) -(**************************************************************************) - -(* Operations on internal representations of values *) - -type t - -external repr : 'a -> t = "%identity" -external obj : t -> 'a = "%identity" -external magic : 'a -> 'b = "%identity" -external is_int : t -> bool = "%obj_is_int" -let [@inline always] is_block a = not (is_int a) -external tag : t -> int = "?obj_tag" -external size : t -> int = "#obj_length" -external field : t -> int -> t = "%obj_field" -external set_field : t -> int -> t -> unit = "%obj_set_field" -external dup : t -> t = "?obj_dup" diff --git a/jscomp/stdlib-406/obj.mli b/jscomp/stdlib-406/obj.mli deleted file mode 100644 index 429a38cea4..0000000000 --- a/jscomp/stdlib-406/obj.mli +++ /dev/null @@ -1,57 +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. *) -(* *) -(**************************************************************************) - -(** Operations on internal representations of values. - - Not for the casual user. -*) - -type t - -external repr : 'a -> t = "%identity" -external obj : t -> 'a = "%identity" -external magic : 'a -> 'b = "%identity" -val [@inline always] is_block : t -> bool - -external tag : t -> int = "?obj_tag" -external size : t -> int = "#obj_length" - - (** - Computes the total size (in words, including the headers) of all - heap blocks accessible from the argument. Statically - allocated blocks are excluded. - - @Since 4.04 - *) - -external field : t -> int -> t = "%obj_field" - -(** When using flambda: - - [set_field] MUST NOT be called on immutable blocks. (Blocks allocated - in C stubs, or with [new_block] below, are always considered mutable.) - - For experts only: - [set_field] et al can be made safe by first wrapping the block in - {!Sys.opaque_identity}, so any information about its contents will not - be propagated. -*) -external set_field : t -> int -> t -> unit = "%obj_set_field" -external dup : t -> t = "?obj_dup" - - - - - diff --git a/jscomp/stdlib-406/obj.res b/jscomp/stdlib-406/obj.res new file mode 100644 index 0000000000..faa1e6106e --- /dev/null +++ b/jscomp/stdlib-406/obj.res @@ -0,0 +1,29 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Operations on internal representations of values */ + +type t + +external repr: 'a => t = "%identity" +external obj: t => 'a = "%identity" +external magic: 'a => 'b = "%identity" +external is_int: t => bool = "%obj_is_int" +@inline(always) let is_block = a => !is_int(a) +external tag: t => int = "?obj_tag" +external size: t => int = "#obj_length" +external field: (t, int) => t = "%obj_field" +external set_field: (t, int, t) => unit = "%obj_set_field" +external dup: t => t = "?obj_dup" diff --git a/jscomp/stdlib-406/obj.resi b/jscomp/stdlib-406/obj.resi new file mode 100644 index 0000000000..fd1192ef5d --- /dev/null +++ b/jscomp/stdlib-406/obj.resi @@ -0,0 +1,52 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Operations on internal representations of values. + + Not for the casual user. +") + +type t + +external repr: 'a => t = "%identity" +external obj: t => 'a = "%identity" +external magic: 'a => 'b = "%identity" +@inline(always) let is_block: t => bool + +external tag: t => int = "?obj_tag" +external size: t => int = "#obj_length" + +@@ocaml.text(" + Computes the total size (in words, including the headers) of all + heap blocks accessible from the argument. Statically + allocated blocks are excluded. + + @Since 4.04 + ") + +external field: (t, int) => t = "%obj_field" + +@ocaml.doc(" When using flambda: + + [set_field] MUST NOT be called on immutable blocks. (Blocks allocated + in C stubs, or with [new_block] below, are always considered mutable.) + + For experts only: + [set_field] et al can be made safe by first wrapping the block in + {!Sys.opaque_identity}, so any information about its contents will not + be propagated. +") +external set_field: (t, int, t) => unit = "%obj_set_field" +external dup: t => t = "?obj_dup" diff --git a/jscomp/stdlib-406/parsing.ml b/jscomp/stdlib-406/parsing.ml deleted file mode 100644 index 5edc7db8ae..0000000000 --- a/jscomp/stdlib-406/parsing.ml +++ /dev/null @@ -1,212 +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. *) -(* *) -(**************************************************************************) - -(* The parsing engine *) - -open Lexing - -(* Internal interface to the parsing engine *) - -type parser_env = - { mutable s_stack : int array; (* States *) - mutable v_stack : Obj.t array; (* Semantic attributes *) - mutable symb_start_stack : position array; (* Start positions *) - mutable symb_end_stack : position array; (* End positions *) - mutable stacksize : int; (* Size of the stacks *) - mutable stackbase : int; (* Base sp for current parse *) - mutable curr_char : int; (* Last token read *) - mutable lval : Obj.t; (* Its semantic attribute *) - mutable symb_start : position; (* Start pos. of the current symbol*) - mutable symb_end : position; (* End pos. of the current symbol *) - mutable asp : int; (* The stack pointer for attributes *) - mutable rule_len : int; (* Number of rhs items in the rule *) - mutable rule_number : int; (* Rule number to reduce by *) - mutable sp : int; (* Saved sp for parse_engine *) - mutable state : int; (* Saved state for parse_engine *) - mutable errflag : int } (* Saved error flag for parse_engine *) - -type parse_tables = - { actions : (parser_env -> Obj.t) array; - transl_const : int array; - transl_block : int array; - lhs : string; - len : string; - defred : string; - dgoto : string; - sindex : string; - rindex : string; - gindex : string; - tablesize : int; - table : string; - check : string; - error_function : string -> unit; - names_const : string; - names_block : string } - -exception YYexit of Obj.t -exception Parse_error - -type parser_input = - Start - | Token_read - | Stacks_grown_1 - | Stacks_grown_2 - | Semantic_action_computed - | Error_detected - -type parser_output = - Read_token - | Raise_parse_error - | Grow_stacks_1 - | Grow_stacks_2 - | Compute_semantic_action - | Call_error_function - -(* to avoid warnings *) -let _ = [Read_token; Raise_parse_error; Grow_stacks_1; Grow_stacks_2; - Compute_semantic_action; Call_error_function] - -external parse_engine : - parse_tables -> parser_env -> parser_input -> Obj.t -> parser_output - = "?parse_engine" - -external set_trace: bool -> bool - = "?set_parser_trace" - -let env = - { s_stack = Array.make 100 0; - v_stack = Array.make 100 (Obj.repr ()); - symb_start_stack = Array.make 100 dummy_pos; - symb_end_stack = Array.make 100 dummy_pos; - stacksize = 100; - stackbase = 0; - curr_char = 0; - lval = Obj.repr (); - symb_start = dummy_pos; - symb_end = dummy_pos; - asp = 0; - rule_len = 0; - rule_number = 0; - sp = 0; - state = 0; - errflag = 0 } - -let grow_stacks() = - let oldsize = env.stacksize in - let newsize = oldsize * 2 in - let new_s = Array.make newsize 0 - and new_v = Array.make newsize (Obj.repr ()) - and new_start = Array.make newsize dummy_pos - and new_end = Array.make newsize dummy_pos in - Array.blit env.s_stack 0 new_s 0 oldsize; - env.s_stack <- new_s; - Array.blit env.v_stack 0 new_v 0 oldsize; - env.v_stack <- new_v; - Array.blit env.symb_start_stack 0 new_start 0 oldsize; - env.symb_start_stack <- new_start; - Array.blit env.symb_end_stack 0 new_end 0 oldsize; - env.symb_end_stack <- new_end; - env.stacksize <- newsize - -let clear_parser() = - Array.fill env.v_stack 0 env.stacksize (Obj.repr ()); - env.lval <- Obj.repr () - -let current_lookahead_fun = ref (fun (_ : Obj.t) -> false) - -let yyparse tables start lexer lexbuf = - let rec loop cmd arg = - match parse_engine tables env cmd arg with - Read_token -> - let t = Obj.repr(lexer lexbuf) in - env.symb_start <- lexbuf.lex_start_p; - env.symb_end <- lexbuf.lex_curr_p; - loop Token_read t - | Raise_parse_error -> - raise Parse_error - | Compute_semantic_action -> - let (action, value) = - try - (Semantic_action_computed, tables.actions.(env.rule_number) env) - with Parse_error -> - (Error_detected, Obj.repr ()) in - loop action value - | Grow_stacks_1 -> - grow_stacks(); loop Stacks_grown_1 (Obj.repr ()) - | Grow_stacks_2 -> - grow_stacks(); loop Stacks_grown_2 (Obj.repr ()) - | Call_error_function -> - tables.error_function "syntax error"; - loop Error_detected (Obj.repr ()) in - let init_asp = env.asp - and init_sp = env.sp - and init_stackbase = env.stackbase - and init_state = env.state - and init_curr_char = env.curr_char - and init_lval = env.lval - and init_errflag = env.errflag in - env.stackbase <- env.sp + 1; - env.curr_char <- start; - env.symb_end <- lexbuf.lex_curr_p; - try - loop Start (Obj.repr ()) - with exn -> - let curr_char = env.curr_char in - env.asp <- init_asp; - env.sp <- init_sp; - env.stackbase <- init_stackbase; - env.state <- init_state; - env.curr_char <- init_curr_char; - env.lval <- init_lval; - env.errflag <- init_errflag; - match exn with - YYexit v -> - Obj.magic v - | _ -> - current_lookahead_fun := - (fun tok -> - if - (Js.typeof tok <> "number") - then tables.transl_block.(Obj.tag tok) = curr_char - else tables.transl_const.(Obj.magic tok) = curr_char); - raise exn - -let peek_val env n = - Obj.magic env.v_stack.(env.asp - n) - -let symbol_start_pos () = - let rec loop i = - if i <= 0 then env.symb_end_stack.(env.asp) - else begin - let st = env.symb_start_stack.(env.asp - i + 1) in - let en = env.symb_end_stack.(env.asp - i + 1) in - if st <> en then st else loop (i - 1) - end - in - loop env.rule_len - -let symbol_end_pos () = env.symb_end_stack.(env.asp) -let rhs_start_pos n = env.symb_start_stack.(env.asp - (env.rule_len - n)) -let rhs_end_pos n = env.symb_end_stack.(env.asp - (env.rule_len - n)) - -let symbol_start () = (symbol_start_pos ()).pos_cnum -let symbol_end () = (symbol_end_pos ()).pos_cnum -let rhs_start n = (rhs_start_pos n).pos_cnum -let rhs_end n = (rhs_end_pos n).pos_cnum - -let is_current_lookahead tok = - (!current_lookahead_fun)(Obj.repr tok) - -let parse_error (_ : string) = () diff --git a/jscomp/stdlib-406/parsing.mli b/jscomp/stdlib-406/parsing.mli deleted file mode 100644 index 73b9504d4f..0000000000 --- a/jscomp/stdlib-406/parsing.mli +++ /dev/null @@ -1,105 +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. *) -(* *) -(**************************************************************************) - -(** The run-time library for parsers generated by [ocamlyacc]. *) - -val symbol_start : unit -> int -(** [symbol_start] and {!Parsing.symbol_end} are to be called in the - action part of a grammar rule only. They return the offset of the - string that matches the left-hand side of the rule: [symbol_start()] - returns the offset of the first character; [symbol_end()] returns the - offset after the last character. The first character in a file is at - offset 0. *) - -val symbol_end : unit -> int -(** See {!Parsing.symbol_start}. *) - -val rhs_start : int -> int -(** Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but - return the offset of the string matching the [n]th item on the - right-hand side of the rule, where [n] is the integer parameter - to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. *) - -val rhs_end : int -> int -(** See {!Parsing.rhs_start}. *) - -val symbol_start_pos : unit -> Lexing.position -(** Same as [symbol_start], but return a [position] instead of an offset. *) - -val symbol_end_pos : unit -> Lexing.position -(** Same as [symbol_end], but return a [position] instead of an offset. *) - -val rhs_start_pos : int -> Lexing.position -(** Same as [rhs_start], but return a [position] instead of an offset. *) - -val rhs_end_pos : int -> Lexing.position -(** Same as [rhs_end], but return a [position] instead of an offset. *) - -val clear_parser : unit -> unit -(** Empty the parser stack. Call it just after a parsing function - has returned, to remove all pointers from the parser stack - to structures that were built by semantic actions during parsing. - This is optional, but lowers the memory requirements of the - programs. *) - -exception Parse_error -(** Raised when a parser encounters a syntax error. - Can also be raised from the action part of a grammar rule, - to initiate error recovery. *) - -val set_trace: bool -> bool -(** Control debugging support for [ocamlyacc]-generated parsers. - After [Parsing.set_trace true], the pushdown automaton that - executes the parsers prints a trace of its actions (reading a token, - shifting a state, reducing by a rule) on standard output. - [Parsing.set_trace false] turns this debugging trace off. - The boolean returned is the previous state of the trace flag. - @since 3.11.0 -*) - -(**/**) - -(** {1 } *) - -(** The following definitions are used by the generated parsers only. - They are not intended to be used directly by user programs. *) - -type parser_env - -type parse_tables = - { actions : (parser_env -> Obj.t) array; - transl_const : int array; - transl_block : int array; - lhs : string; - len : string; - defred : string; - dgoto : string; - sindex : string; - rindex : string; - gindex : string; - tablesize : int; - table : string; - check : string; - error_function : string -> unit; - names_const : string; - names_block : string } - -exception YYexit of Obj.t - -val yyparse : - parse_tables -> int -> (Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'b -val peek_val : parser_env -> int -> 'a -val is_current_lookahead : 'a -> bool -val parse_error : string -> unit diff --git a/jscomp/stdlib-406/parsing.res b/jscomp/stdlib-406/parsing.res new file mode 100644 index 0000000000..6614e94357 --- /dev/null +++ b/jscomp/stdlib-406/parsing.res @@ -0,0 +1,232 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* The parsing engine */ + +open Lexing + +/* Internal interface to the parsing engine */ + +type parser_env = { + mutable s_stack: array /* States */, + mutable v_stack: array /* Semantic attributes */, + mutable symb_start_stack: array /* Start positions */, + mutable symb_end_stack: array /* End positions */, + mutable stacksize: int /* Size of the stacks */, + mutable stackbase: int /* Base sp for current parse */, + mutable curr_char: int /* Last token read */, + mutable lval: Obj.t /* Its semantic attribute */, + mutable symb_start: position /* Start pos. of the current symbol */, + mutable symb_end: position /* End pos. of the current symbol */, + mutable asp: int /* The stack pointer for attributes */, + mutable rule_len: int /* Number of rhs items in the rule */, + mutable rule_number: int /* Rule number to reduce by */, + mutable sp: int /* Saved sp for parse_engine */, + mutable state: int /* Saved state for parse_engine */, + mutable errflag: int, +} /* Saved error flag for parse_engine */ + +type parse_tables = { + actions: array Obj.t>, + transl_const: array, + transl_block: array, + lhs: string, + len: string, + defred: string, + dgoto: string, + sindex: string, + rindex: string, + gindex: string, + tablesize: int, + table: string, + check: string, + error_function: string => unit, + names_const: string, + names_block: string, +} + +exception YYexit(Obj.t) +exception Parse_error + +type parser_input = + | Start + | Token_read + | Stacks_grown_1 + | Stacks_grown_2 + | Semantic_action_computed + | Error_detected + +type parser_output = + | Read_token + | Raise_parse_error + | Grow_stacks_1 + | Grow_stacks_2 + | Compute_semantic_action + | Call_error_function + +/* to avoid warnings */ +let _ = list{ + Read_token, + Raise_parse_error, + Grow_stacks_1, + Grow_stacks_2, + Compute_semantic_action, + Call_error_function, +} + +external parse_engine: (parse_tables, parser_env, parser_input, Obj.t) => parser_output = + "?parse_engine" + +external set_trace: bool => bool = "?set_parser_trace" + +let env = { + s_stack: Array.make(100, 0), + v_stack: Array.make(100, Obj.repr()), + symb_start_stack: Array.make(100, dummy_pos), + symb_end_stack: Array.make(100, dummy_pos), + stacksize: 100, + stackbase: 0, + curr_char: 0, + lval: Obj.repr(), + symb_start: dummy_pos, + symb_end: dummy_pos, + asp: 0, + rule_len: 0, + rule_number: 0, + sp: 0, + state: 0, + errflag: 0, +} + +let grow_stacks = () => { + let oldsize = env.stacksize + let newsize = oldsize * 2 + let new_s = Array.make(newsize, 0) + and new_v = Array.make(newsize, Obj.repr()) + and new_start = Array.make(newsize, dummy_pos) + and new_end = Array.make(newsize, dummy_pos) + Array.blit(env.s_stack, 0, new_s, 0, oldsize) + env.s_stack = new_s + Array.blit(env.v_stack, 0, new_v, 0, oldsize) + env.v_stack = new_v + Array.blit(env.symb_start_stack, 0, new_start, 0, oldsize) + env.symb_start_stack = new_start + Array.blit(env.symb_end_stack, 0, new_end, 0, oldsize) + env.symb_end_stack = new_end + env.stacksize = newsize +} + +let clear_parser = () => { + Array.fill(env.v_stack, 0, env.stacksize, Obj.repr()) + env.lval = Obj.repr() +} + +let current_lookahead_fun = ref((_: Obj.t) => false) + +let yyparse = (tables, start, lexer, lexbuf) => { + let rec loop = (cmd, arg) => + switch parse_engine(tables, env, cmd, arg) { + | Read_token => + let t = Obj.repr(lexer(lexbuf)) + env.symb_start = lexbuf.lex_start_p + env.symb_end = lexbuf.lex_curr_p + loop(Token_read, t) + | Raise_parse_error => raise(Parse_error) + | Compute_semantic_action => + let (action, value) = try ( + Semantic_action_computed, + tables.actions[env.rule_number](env), + ) catch { + | Parse_error => (Error_detected, Obj.repr()) + } + loop(action, value) + | Grow_stacks_1 => + grow_stacks() + loop(Stacks_grown_1, Obj.repr()) + | Grow_stacks_2 => + grow_stacks() + loop(Stacks_grown_2, Obj.repr()) + | Call_error_function => + tables.error_function("syntax error") + loop(Error_detected, Obj.repr()) + } + let init_asp = env.asp + and init_sp = env.sp + and init_stackbase = env.stackbase + and init_state = env.state + and init_curr_char = env.curr_char + and init_lval = env.lval + and init_errflag = env.errflag + env.stackbase = env.sp + 1 + env.curr_char = start + env.symb_end = lexbuf.lex_curr_p + try loop(Start, Obj.repr()) catch { + | exn => + let curr_char = env.curr_char + env.asp = init_asp + env.sp = init_sp + env.stackbase = init_stackbase + env.state = init_state + env.curr_char = init_curr_char + env.lval = init_lval + env.errflag = init_errflag + switch exn { + | YYexit(v) => Obj.magic(v) + | _ => + current_lookahead_fun := + ( + tok => + if Js.typeof(tok) != "number" { + tables.transl_block[Obj.tag(tok)] == curr_char + } else { + tables.transl_const[Obj.magic(tok)] == curr_char + } + ) + raise(exn) + } + } +} + +let peek_val = (env, n) => Obj.magic(env.v_stack[env.asp - n]) + +let symbol_start_pos = () => { + let rec loop = i => + if i <= 0 { + env.symb_end_stack[env.asp] + } else { + let st = env.symb_start_stack[env.asp - i + 1] + let en = env.symb_end_stack[env.asp - i + 1] + if st != en { + st + } else { + loop(i - 1) + } + } + + loop(env.rule_len) +} + +let symbol_end_pos = () => env.symb_end_stack[env.asp] +let rhs_start_pos = n => env.symb_start_stack[env.asp - (env.rule_len - n)] +let rhs_end_pos = n => env.symb_end_stack[env.asp - (env.rule_len - n)] + +let symbol_start = () => symbol_start_pos().pos_cnum +let symbol_end = () => symbol_end_pos().pos_cnum +let rhs_start = n => rhs_start_pos(n).pos_cnum +let rhs_end = n => rhs_end_pos(n).pos_cnum + +let is_current_lookahead = tok => current_lookahead_fun.contents(Obj.repr(tok)) + +let parse_error = (_: string) => () diff --git a/jscomp/stdlib-406/parsing.resi b/jscomp/stdlib-406/parsing.resi new file mode 100644 index 0000000000..d1d1dacbb9 --- /dev/null +++ b/jscomp/stdlib-406/parsing.resi @@ -0,0 +1,107 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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. */ + /* */ + /* ************************************************************************ */ + + " The run-time library for parsers generated by [ocamlyacc]. " +) + +@ocaml.doc(" [symbol_start] and {!Parsing.symbol_end} are to be called in the + action part of a grammar rule only. They return the offset of the + string that matches the left-hand side of the rule: [symbol_start()] + returns the offset of the first character; [symbol_end()] returns the + offset after the last character. The first character in a file is at + offset 0. ") +let symbol_start: unit => int + +@ocaml.doc(" See {!Parsing.symbol_start}. ") +let symbol_end: unit => int + +@ocaml.doc(" Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but + return the offset of the string matching the [n]th item on the + right-hand side of the rule, where [n] is the integer parameter + to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. ") +let rhs_start: int => int + +@ocaml.doc(" See {!Parsing.rhs_start}. ") +let rhs_end: int => int + +@ocaml.doc(" Same as [symbol_start], but return a [position] instead of an offset. ") +let symbol_start_pos: unit => Lexing.position + +@ocaml.doc(" Same as [symbol_end], but return a [position] instead of an offset. ") +let symbol_end_pos: unit => Lexing.position + +@ocaml.doc(" Same as [rhs_start], but return a [position] instead of an offset. ") +let rhs_start_pos: int => Lexing.position + +@ocaml.doc(" Same as [rhs_end], but return a [position] instead of an offset. ") +let rhs_end_pos: int => Lexing.position + +@ocaml.doc(" Empty the parser stack. Call it just after a parsing function + has returned, to remove all pointers from the parser stack + to structures that were built by semantic actions during parsing. + This is optional, but lowers the memory requirements of the + programs. ") +let clear_parser: unit => unit + +@ocaml.doc(" Raised when a parser encounters a syntax error. + Can also be raised from the action part of a grammar rule, + to initiate error recovery. ") +exception Parse_error + +@ocaml.doc(" Control debugging support for [ocamlyacc]-generated parsers. + After [Parsing.set_trace true], the pushdown automaton that + executes the parsers prints a trace of its actions (reading a token, + shifting a state, reducing by a rule) on standard output. + [Parsing.set_trace false] turns this debugging trace off. + The boolean returned is the previous state of the trace flag. + @since 3.11.0 +") +let set_trace: bool => bool + +@@ocaml.text("/*") + +@@ocaml.text(" {1 } ") + +@@ocaml.text(" The following definitions are used by the generated parsers only. + They are not intended to be used directly by user programs. ") + +type parser_env + +type parse_tables = { + actions: array Obj.t>, + transl_const: array, + transl_block: array, + lhs: string, + len: string, + defred: string, + dgoto: string, + sindex: string, + rindex: string, + gindex: string, + tablesize: int, + table: string, + check: string, + error_function: string => unit, + names_const: string, + names_block: string, +} + +exception YYexit(Obj.t) + +let yyparse: (parse_tables, int, Lexing.lexbuf => 'a, Lexing.lexbuf) => 'b +let peek_val: (parser_env, int) => 'a +let is_current_lookahead: 'a => bool +let parse_error: string => unit diff --git a/jscomp/stdlib-406/queue.ml b/jscomp/stdlib-406/queue.ml deleted file mode 100644 index ffda7a4672..0000000000 --- a/jscomp/stdlib-406/queue.ml +++ /dev/null @@ -1,132 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Francois Pottier, projet Cristal, INRIA Rocquencourt *) -(* Jeremie Dimino, Jane Street Europe *) -(* *) -(* Copyright 2002 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -exception Empty - -type 'a cell = - | Nil - | Cons of { content: 'a; mutable next: 'a cell } - -type 'a t = { - mutable length: int; - mutable first: 'a cell; - mutable last: 'a cell -} - -let create () = { - length = 0; - first = Nil; - last = Nil -} - -let clear q = - q.length <- 0; - q.first <- Nil; - q.last <- Nil - -let add x q = - let cell = Cons { - content = x; - next = Nil - } in - match q.last with - | Nil -> - q.length <- 1; - q.first <- cell; - q.last <- cell - | Cons last -> - q.length <- q.length + 1; - last.next <- cell; - q.last <- cell - -let push = - add - -let peek q = - match q.first with - | Nil -> raise Empty - | Cons { content } -> content - -let top = - peek - -let take q = - match q.first with - | Nil -> raise Empty - | Cons { content; next = Nil } -> - clear q; - content - | Cons { content; next } -> - q.length <- q.length - 1; - q.first <- next; - content - -let pop = - take - -let copy = - let rec copy q_res prev cell = - match cell with - | Nil -> q_res.last <- prev; q_res - | Cons { content; next } -> - let res = Cons { content; next = Nil } in - begin match prev with - | Nil -> q_res.first <- res - | Cons p -> p.next <- res - end; - copy q_res res next - in - fun q -> copy { length = q.length; first = Nil; last = Nil } Nil q.first - -let is_empty q = - q.length = 0 - -let length q = - q.length - -let iter = - let rec iter f cell = - match cell with - | Nil -> () - | Cons { content; next } -> - f content; - iter f next - in - fun f q -> iter f q.first - -let fold = - let rec fold f accu cell = - match cell with - | Nil -> accu - | Cons { content; next } -> - let accu = f accu content in - fold f accu next - in - fun f accu q -> fold f accu q.first - -let transfer q1 q2 = - if q1.length > 0 then - match q2.last with - | Nil -> - q2.length <- q1.length; - q2.first <- q1.first; - q2.last <- q1.last; - clear q1 - | Cons last -> - q2.length <- q2.length + q1.length; - last.next <- q1.first; - q2.last <- q1.last; - clear q1 diff --git a/jscomp/stdlib-406/queue.mli b/jscomp/stdlib-406/queue.mli deleted file mode 100644 index 46e48fd051..0000000000 --- a/jscomp/stdlib-406/queue.mli +++ /dev/null @@ -1,82 +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. *) -(* *) -(**************************************************************************) - -(** First-in first-out queues. - - This module implements queues (FIFOs), with in-place modification. - - {b Warning} This module is not thread-safe: each {!Queue.t} value - must be protected from concurrent access (e.g. with a [Mutex.t]). - Failure to do so can lead to a crash. -*) - -type 'a t -(** The type of queues containing elements of type ['a]. *) - - -exception Empty -(** Raised when {!Queue.take} or {!Queue.peek} is applied to an empty queue. *) - - -val create : unit -> 'a t -(** Return a new queue, initially empty. *) - -val add : 'a -> 'a t -> unit -(** [add x q] adds the element [x] at the end of the queue [q]. *) - -val push : 'a -> 'a t -> unit -(** [push] is a synonym for [add]. *) - -val take : 'a t -> 'a -(** [take q] removes and returns the first element in queue [q], - or raises {!Empty} if the queue is empty. *) - -val pop : 'a t -> 'a -(** [pop] is a synonym for [take]. *) - -val peek : 'a t -> 'a -(** [peek q] returns the first element in queue [q], without removing - it from the queue, or raises {!Empty} if the queue is empty. *) - -val top : 'a t -> 'a -(** [top] is a synonym for [peek]. *) - -val clear : 'a t -> unit -(** Discard all elements from a queue. *) - -val copy : 'a t -> 'a t -(** Return a copy of the given queue. *) - -val is_empty : 'a t -> bool -(** Return [true] if the given queue is empty, [false] otherwise. *) - -val length : 'a t -> int -(** Return the number of elements in a queue. *) - -val iter : ('a -> unit) -> 'a t -> unit -(** [iter f q] applies [f] in turn to all elements of [q], - from the least recently entered to the most recently entered. - The queue itself is unchanged. *) - -val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b -(** [fold f accu q] is equivalent to [List.fold_left f accu l], - where [l] is the list of [q]'s elements. The queue remains - unchanged. *) - -val transfer : 'a t -> 'a t -> unit -(** [transfer q1 q2] adds all of [q1]'s elements at the end of - the queue [q2], then clears [q1]. It is equivalent to the - sequence [iter (fun x -> add x q2) q1; clear q1], but runs - in constant time. *) diff --git a/jscomp/stdlib-406/queue.res b/jscomp/stdlib-406/queue.res new file mode 100644 index 0000000000..89d9297229 --- /dev/null +++ b/jscomp/stdlib-406/queue.res @@ -0,0 +1,142 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Francois Pottier, projet Cristal, INRIA Rocquencourt */ +/* Jeremie Dimino, Jane Street Europe */ +/* */ +/* Copyright 2002 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +exception Empty + +type rec cell<'a> = + | Nil + | Cons({content: 'a, mutable next: cell<'a>}) + +type t<'a> = { + mutable length: int, + mutable first: cell<'a>, + mutable last: cell<'a>, +} + +let create = () => { + length: 0, + first: Nil, + last: Nil, +} + +let clear = q => { + q.length = 0 + q.first = Nil + q.last = Nil +} + +let add = (x, q) => { + let cell = Cons({ + content: x, + next: Nil, + }) + switch q.last { + | Nil => + q.length = 1 + q.first = cell + q.last = cell + | Cons(last) => + q.length = q.length + 1 + last.next = cell + q.last = cell + } +} + +let push = add + +let peek = q => + switch q.first { + | Nil => raise(Empty) + | Cons({content}) => content + } + +let top = peek + +let take = q => + switch q.first { + | Nil => raise(Empty) + | Cons({content, next: Nil}) => + clear(q) + content + | Cons({content, next}) => + q.length = q.length - 1 + q.first = next + content + } + +let pop = take + +let copy = { + let rec copy = (q_res, prev, cell) => + switch cell { + | Nil => + q_res.last = prev + q_res + | Cons({content, next}) => + let res = Cons({content, next: Nil}) + switch prev { + | Nil => q_res.first = res + | Cons(p) => p.next = res + } + copy(q_res, res, next) + } + + q => copy({length: q.length, first: Nil, last: Nil}, Nil, q.first) +} + +let is_empty = q => q.length == 0 + +let length = q => q.length + +let iter = { + let rec iter = (f, cell) => + switch cell { + | Nil => () + | Cons({content, next}) => + f(content) + iter(f, next) + } + + (f, q) => iter(f, q.first) +} + +let fold = { + let rec fold = (f, accu, cell) => + switch cell { + | Nil => accu + | Cons({content, next}) => + let accu = f(accu, content) + fold(f, accu, next) + } + + (f, accu, q) => fold(f, accu, q.first) +} + +let transfer = (q1, q2) => + if q1.length > 0 { + switch q2.last { + | Nil => + q2.length = q1.length + q2.first = q1.first + q2.last = q1.last + clear(q1) + | Cons(last) => + q2.length = q2.length + q1.length + last.next = q1.first + q2.last = q1.last + clear(q1) + } + } diff --git a/jscomp/stdlib-406/queue.resi b/jscomp/stdlib-406/queue.resi new file mode 100644 index 0000000000..84a9ef2066 --- /dev/null +++ b/jscomp/stdlib-406/queue.resi @@ -0,0 +1,80 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" First-in first-out queues. + + This module implements queues (FIFOs), with in-place modification. + + {b Warning} This module is not thread-safe: each {!Queue.t} value + must be protected from concurrent access (e.g. with a [Mutex.t]). + Failure to do so can lead to a crash. +") + +@ocaml.doc(" The type of queues containing elements of type ['a]. ") +type t<'a> + +@ocaml.doc(" Raised when {!Queue.take} or {!Queue.peek} is applied to an empty queue. ") +exception Empty + +@ocaml.doc(" Return a new queue, initially empty. ") +let create: unit => t<'a> + +@ocaml.doc(" [add x q] adds the element [x] at the end of the queue [q]. ") +let add: ('a, t<'a>) => unit + +@ocaml.doc(" [push] is a synonym for [add]. ") +let push: ('a, t<'a>) => unit + +@ocaml.doc(" [take q] removes and returns the first element in queue [q], + or raises {!Empty} if the queue is empty. ") +let take: t<'a> => 'a + +@ocaml.doc(" [pop] is a synonym for [take]. ") +let pop: t<'a> => 'a + +@ocaml.doc(" [peek q] returns the first element in queue [q], without removing + it from the queue, or raises {!Empty} if the queue is empty. ") +let peek: t<'a> => 'a + +@ocaml.doc(" [top] is a synonym for [peek]. ") +let top: t<'a> => 'a + +@ocaml.doc(" Discard all elements from a queue. ") +let clear: t<'a> => unit + +@ocaml.doc(" Return a copy of the given queue. ") +let copy: t<'a> => t<'a> + +@ocaml.doc(" Return [true] if the given queue is empty, [false] otherwise. ") +let is_empty: t<'a> => bool + +@ocaml.doc(" Return the number of elements in a queue. ") +let length: t<'a> => int + +@ocaml.doc(" [iter f q] applies [f] in turn to all elements of [q], + from the least recently entered to the most recently entered. + The queue itself is unchanged. ") +let iter: ('a => unit, t<'a>) => unit + +@ocaml.doc(" [fold f accu q] is equivalent to [List.fold_left f accu l], + where [l] is the list of [q]'s elements. The queue remains + unchanged. ") +let fold: (('b, 'a) => 'b, 'b, t<'a>) => 'b + +@ocaml.doc(" [transfer q1 q2] adds all of [q1]'s elements at the end of + the queue [q2], then clears [q1]. It is equivalent to the + sequence [iter (fun x -> add x q2) q1; clear q1], but runs + in constant time. ") +let transfer: (t<'a>, t<'a>) => unit diff --git a/jscomp/stdlib-406/random.ml b/jscomp/stdlib-406/random.ml deleted file mode 100644 index 29d3bec5f6..0000000000 --- a/jscomp/stdlib-406/random.ml +++ /dev/null @@ -1,273 +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 -> int array = fun _ -> - let seed :int = [%raw "Math.floor(Math.random()*0x7fffffff)"] in - [|seed|] - -module State = struct - - type t = { st : int 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 ^ string_of_int x) in - let extract d = - Char.code d.[0] + (Char.code d.[1] lsl 8) + (Char.code d.[2] lsl 16) - + (Char.code d.[3] lsl 24) - in - let seed = if Array.length seed = 0 then [| 0 |] else seed in - let l = Array.length seed in - for i = 0 to 54 do - s.st.(i) <- i; - done; - let accu = ref "x" in - for i = 0 to 54 + max 55 l do - let j = i mod 55 in - let k = i mod l in - accu := combine !accu seed.(k); - s.st.(j) <- (s.st.(j) lxor extract !accu) land 0x3FFFFFFF; (* PR#5575 *) - done; - s.idx <- 0 - - - let make seed = - let result = new_state () in - full_init result seed; - result - - - let make_self_init () = make (random_seed ()) - - let copy s = - let result = new_state () in - assign result s; - result - - - (* Returns 30 random bits as an integer 0 <= x < 1073741824 *) - let bits s = - s.idx <- (s.idx + 1) mod 55; - let curval = s.st.(s.idx) in - let newval = s.st.((s.idx + 24) mod 55) - + (curval lxor ((curval lsr 25) land 0x1F)) in - let newval30 = newval land 0x3FFFFFFF in (* PR#5575 *) - s.st.(s.idx) <- newval30; - newval30 - - - let rec intaux s n = - let r = bits s in - let v = r mod n in - if r - v > 0x3FFFFFFF - n + 1 then intaux s n else v - - let int s bound = - if bound > 0x3FFFFFFF || bound <= 0 - then invalid_arg "Random.int" - else intaux s bound - - - let rec int32aux s n = - let b1 = Int32.of_int (bits s) in - let b2 = Int32.shift_left (Int32.of_int (bits s land 1)) 30 in - let r = Int32.logor b1 b2 in - let v = Int32.rem r n in - if Int32.sub r v > Int32.add (Int32.sub Int32.max_int n) 1l - then int32aux s n - else v - - let int32 s bound = - if bound <= 0l - then invalid_arg "Random.int32" - else int32aux s bound - - - let rec int64aux s n = - let b1 = Int64.of_int (bits s) in - let b2 = Int64.shift_left (Int64.of_int (bits s)) 30 in - let b3 = Int64.shift_left (Int64.of_int (bits s land 7)) 60 in - let r = Int64.logor b1 (Int64.logor b2 b3) in - let v = Int64.rem r n in - if Int64.sub r v > Int64.add (Int64.sub Int64.max_int n) 1L - then int64aux s n - else v - - let int64 s bound = - if bound <= 0L - then 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) - in (r1 /. scale +. r2) /. scale - - - let float s bound = rawfloat s *. bound - - let bool s = (bits s land 1 = 0) - -end - -(* 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.mli b/jscomp/stdlib-406/random.mli deleted file mode 100644 index f309ecf4ea..0000000000 --- a/jscomp/stdlib-406/random.mli +++ /dev/null @@ -1,102 +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} *) - -val init : int -> unit -(** Initialize the generator, using the argument as a seed. - The same seed will always yield the same sequence of numbers. *) - -val full_init : int array -> unit -(** Same as {!Random.init} but takes more data as seed. *) - -val self_init : unit -> 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). *) - -val bits : unit -> int -(** Return 30 random bits in a nonnegative integer. - @before 3.12.0 used a different algorithm (affects all the following - functions) -*) - -val int : int -> 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}. *) - -val int32 : Int32.t -> Int32.t -(** [Random.int32 bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0. *) - -val int64 : Int64.t -> Int64.t -(** [Random.int64 bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0. *) - -val float : float -> float -(** [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. *) - -val bool : unit -> bool -(** [Random.bool ()] returns [true] or [false] with probability 0.5 each. *) - - -(** {1 Advanced functions} *) - -(** 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. -*) - -module State : sig - type t - (** The type of PRNG states. *) - - val make : int array -> t - (** Create a new state and initialize it with the given seed. *) - - val make_self_init : unit -> t - (** Create a new state and initialize it with a system-dependent - low-entropy seed. *) - - val copy : t -> t - (** Return a copy of the given state. *) - - val bits : t -> int - val int : t -> int -> int - val int32 : t -> Int32.t -> Int32.t - val int64 : t -> Int64.t -> Int64.t - val float : t -> float -> float - val bool : t -> bool - (** These functions are the same as the basic functions, except that they - use (and update) the given PRNG state instead of the default one. - *) -end - - -val get_state : unit -> State.t -(** Return the current state of the generator used by the basic functions. *) - -val set_state : State.t -> unit -(** Set the state of the generator used by the basic functions. *) diff --git a/jscomp/stdlib-406/random.res b/jscomp/stdlib-406/random.res new file mode 100644 index 0000000000..11b4e42f4d --- /dev/null +++ b/jscomp/stdlib-406/random.res @@ -0,0 +1,336 @@ +/* ************************************************************************ */ +/* */ +/* 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 ++ string_of_int(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 new file mode 100644 index 0000000000..790887f524 --- /dev/null +++ b/jscomp/stdlib-406/random.resi @@ -0,0 +1,102 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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). " +) + +@@ocaml.text(" {1 Basic functions} ") + +@ocaml.doc(" Initialize the generator, using the argument as a seed. + The same seed will always yield the same sequence of numbers. ") +let init: int => unit + +@ocaml.doc(" Same as {!Random.init} but takes more data as seed. ") +let full_init: array => unit + +@ocaml.doc(" 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 + +@ocaml.doc(" 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 + +@ocaml.doc(" [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 + +@ocaml.doc(" [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 + +@ocaml.doc(" [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 + +@ocaml.doc(" [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 + +@ocaml.doc(" [Random.bool ()] returns [true] or [false] with probability 0.5 each. ") +let bool: unit => bool + +@@ocaml.text(" {1 Advanced functions} ") + +@@ocaml.text(" 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. +") + +module State: { + @ocaml.doc(" The type of PRNG states. ") + type t + + @ocaml.doc(" Create a new state and initialize it with the given seed. ") + let make: array => t + + @ocaml.doc(" Create a new state and initialize it with a system-dependent + low-entropy seed. ") + let make_self_init: unit => t + + @ocaml.doc(" 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 + @ocaml.doc(" 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 +} + +@ocaml.doc(" Return the current state of the generator used by the basic functions. ") +let get_state: unit => State.t + +@ocaml.doc(" 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 4cd3d18003..7356eb45ba 100644 --- a/jscomp/stdlib-406/release.ninja +++ b/jscomp/stdlib-406/release.ninja @@ -14,79 +14,79 @@ o stdlib-406/pervasives.cmi : cc stdlib-406/pervasives.resi | $bsc others bsc_flags = $bsc_flags -nopervasives o stdlib-406/arg.cmj : cc_cmi stdlib-406/arg.res | stdlib-406/arg.cmi stdlib-406/array.cmj stdlib-406/buffer.cmj stdlib-406/list.cmj stdlib-406/string.cmj stdlib-406/sys.cmj $bsc others o stdlib-406/arg.cmi : cc stdlib-406/arg.resi | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/array.cmj : cc_cmi stdlib-406/array.ml | stdlib-406/array.cmi $bsc others -o stdlib-406/array.cmi : cc stdlib-406/array.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/arrayLabels.cmj : cc_cmi stdlib-406/arrayLabels.ml | stdlib-406/arrayLabels.cmi $bsc others -o stdlib-406/arrayLabels.cmi : cc stdlib-406/arrayLabels.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/buffer.cmj : cc_cmi stdlib-406/buffer.ml | stdlib-406/buffer.cmi stdlib-406/bytes.cmj stdlib-406/char.cmj stdlib-406/string.cmj stdlib-406/uchar.cmj $bsc others -o stdlib-406/buffer.cmi : cc stdlib-406/buffer.mli | stdlib-406/pervasives.cmj stdlib-406/uchar.cmi $bsc others -o stdlib-406/bytes.cmj : cc_cmi stdlib-406/bytes.ml | stdlib-406/bytes.cmi stdlib-406/char.cmj $bsc others -o stdlib-406/bytes.cmi : cc stdlib-406/bytes.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/bytesLabels.cmj : cc_cmi stdlib-406/bytesLabels.ml | stdlib-406/bytesLabels.cmi stdlib-406/char.cmj $bsc others -o stdlib-406/bytesLabels.cmi : cc stdlib-406/bytesLabels.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/callback.cmj : cc_cmi stdlib-406/callback.ml | stdlib-406/callback.cmi $bsc others -o stdlib-406/callback.cmi : cc stdlib-406/callback.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/camlinternalLazy.cmj : cc_cmi stdlib-406/camlinternalLazy.ml | stdlib-406/camlinternalLazy.cmi $bsc others -o stdlib-406/camlinternalLazy.cmi : cc stdlib-406/camlinternalLazy.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/camlinternalMod.cmj : cc_cmi stdlib-406/camlinternalMod.ml | stdlib-406/camlinternalMod.cmi stdlib-406/obj.cmj $bsc others -o stdlib-406/camlinternalMod.cmi : cc stdlib-406/camlinternalMod.mli | stdlib-406/obj.cmi stdlib-406/pervasives.cmj $bsc others -o stdlib-406/char.cmj : cc_cmi stdlib-406/char.ml | stdlib-406/char.cmi $bsc others -o stdlib-406/char.cmi : cc stdlib-406/char.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/complex.cmj : cc_cmi stdlib-406/complex.ml | stdlib-406/complex.cmi $bsc others -o stdlib-406/complex.cmi : cc stdlib-406/complex.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/digest.cmj : cc_cmi stdlib-406/digest.ml | 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.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/filename.cmj : cc_cmi stdlib-406/filename.ml | stdlib-406/buffer.cmj stdlib-406/filename.cmi stdlib-406/string.cmj stdlib-406/sys.cmj $bsc others -o stdlib-406/filename.cmi : cc stdlib-406/filename.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/genlex.cmj : cc_cmi stdlib-406/genlex.ml | stdlib-406/bytes.cmj stdlib-406/char.cmj stdlib-406/genlex.cmi stdlib-406/hashtbl.cmj stdlib-406/list.cmj stdlib-406/stream.cmj stdlib-406/string.cmj $bsc others -o stdlib-406/genlex.cmi : cc stdlib-406/genlex.mli | stdlib-406/pervasives.cmj stdlib-406/stream.cmi $bsc others -o stdlib-406/hashtbl.cmj : cc_cmi stdlib-406/hashtbl.ml | 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.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/hashtblLabels.cmi stdlib-406/hashtblLabels.cmj : cc stdlib-406/hashtblLabels.ml | stdlib-406/hashtbl.cmj stdlib-406/pervasives.cmj $bsc others -o stdlib-406/int32.cmj : cc_cmi stdlib-406/int32.ml | stdlib-406/int32.cmi $bsc others -o stdlib-406/int32.cmi : cc stdlib-406/int32.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/int64.cmj : cc_cmi stdlib-406/int64.ml | stdlib-406/int64.cmi $bsc others -o stdlib-406/int64.cmi : cc stdlib-406/int64.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/lazy.cmj : cc_cmi stdlib-406/lazy.ml | stdlib-406/camlinternalLazy.cmj stdlib-406/lazy.cmi $bsc others -o stdlib-406/lazy.cmi : cc stdlib-406/lazy.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/lexing.cmj : cc_cmi stdlib-406/lexing.ml | stdlib-406/array.cmj stdlib-406/bytes.cmj stdlib-406/lexing.cmi stdlib-406/string.cmj $bsc others -o stdlib-406/lexing.cmi : cc stdlib-406/lexing.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/list.cmj : cc_cmi stdlib-406/list.ml | stdlib-406/list.cmi $bsc others -o stdlib-406/list.cmi : cc stdlib-406/list.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/listLabels.cmj : cc_cmi stdlib-406/listLabels.ml | stdlib-406/listLabels.cmi $bsc others -o stdlib-406/listLabels.cmi : cc stdlib-406/listLabels.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/map.cmj : cc_cmi stdlib-406/map.ml | stdlib-406/map.cmi $bsc others -o stdlib-406/map.cmi : cc stdlib-406/map.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/mapLabels.cmi stdlib-406/mapLabels.cmj : cc stdlib-406/mapLabels.ml | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/moreLabels.cmj : cc_cmi stdlib-406/moreLabels.ml | 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.mli | 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.ml | stdlib-406/obj.cmi $bsc others -o stdlib-406/obj.cmi : cc stdlib-406/obj.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/parsing.cmj : cc_cmi stdlib-406/parsing.ml | stdlib-406/array.cmj stdlib-406/lexing.cmj stdlib-406/obj.cmj stdlib-406/parsing.cmi $bsc others -o stdlib-406/parsing.cmi : cc stdlib-406/parsing.mli | stdlib-406/lexing.cmi stdlib-406/obj.cmi stdlib-406/pervasives.cmj $bsc others +o stdlib-406/array.cmj : cc_cmi stdlib-406/array.res | stdlib-406/array.cmi $bsc others +o stdlib-406/array.cmi : cc stdlib-406/array.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/arrayLabels.cmj : cc_cmi stdlib-406/arrayLabels.res | stdlib-406/arrayLabels.cmi $bsc others +o stdlib-406/arrayLabels.cmi : cc stdlib-406/arrayLabels.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/buffer.cmj : cc_cmi stdlib-406/buffer.res | stdlib-406/buffer.cmi stdlib-406/bytes.cmj stdlib-406/char.cmj stdlib-406/string.cmj stdlib-406/uchar.cmj $bsc others +o stdlib-406/buffer.cmi : cc stdlib-406/buffer.resi | stdlib-406/pervasives.cmj stdlib-406/uchar.cmi $bsc others +o stdlib-406/bytes.cmj : cc_cmi stdlib-406/bytes.res | stdlib-406/bytes.cmi stdlib-406/char.cmj $bsc others +o stdlib-406/bytes.cmi : cc stdlib-406/bytes.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/bytesLabels.cmj : cc_cmi stdlib-406/bytesLabels.res | stdlib-406/bytesLabels.cmi stdlib-406/char.cmj $bsc others +o stdlib-406/bytesLabels.cmi : cc stdlib-406/bytesLabels.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/callback.cmj : cc_cmi stdlib-406/callback.res | stdlib-406/callback.cmi $bsc others +o stdlib-406/callback.cmi : cc stdlib-406/callback.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/camlinternalLazy.cmj : cc_cmi stdlib-406/camlinternalLazy.res | stdlib-406/camlinternalLazy.cmi $bsc others +o stdlib-406/camlinternalLazy.cmi : cc stdlib-406/camlinternalLazy.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/camlinternalMod.cmj : cc_cmi stdlib-406/camlinternalMod.res | stdlib-406/camlinternalMod.cmi stdlib-406/obj.cmj $bsc others +o stdlib-406/camlinternalMod.cmi : cc stdlib-406/camlinternalMod.resi | stdlib-406/obj.cmi stdlib-406/pervasives.cmj $bsc others +o stdlib-406/char.cmj : cc_cmi stdlib-406/char.res | stdlib-406/char.cmi $bsc others +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/filename.cmj : cc_cmi stdlib-406/filename.res | stdlib-406/buffer.cmj stdlib-406/filename.cmi stdlib-406/string.cmj stdlib-406/sys.cmj $bsc others +o stdlib-406/filename.cmi : cc stdlib-406/filename.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/genlex.cmj : cc_cmi stdlib-406/genlex.res | stdlib-406/bytes.cmj stdlib-406/char.cmj stdlib-406/genlex.cmi stdlib-406/hashtbl.cmj stdlib-406/list.cmj stdlib-406/stream.cmj stdlib-406/string.cmj $bsc others +o stdlib-406/genlex.cmi : cc stdlib-406/genlex.resi | stdlib-406/pervasives.cmj stdlib-406/stream.cmi $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 +o stdlib-406/int64.cmi : cc stdlib-406/int64.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/lazy.cmj : cc_cmi stdlib-406/lazy.res | stdlib-406/camlinternalLazy.cmj stdlib-406/lazy.cmi $bsc others +o stdlib-406/lazy.cmi : cc stdlib-406/lazy.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/lexing.cmj : cc_cmi stdlib-406/lexing.res | stdlib-406/array.cmj stdlib-406/bytes.cmj stdlib-406/lexing.cmi stdlib-406/string.cmj $bsc others +o stdlib-406/lexing.cmi : cc stdlib-406/lexing.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/list.cmj : cc_cmi stdlib-406/list.res | stdlib-406/list.cmi $bsc others +o stdlib-406/list.cmi : cc stdlib-406/list.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/listLabels.cmj : cc_cmi stdlib-406/listLabels.res | stdlib-406/listLabels.cmi $bsc others +o stdlib-406/listLabels.cmi : cc stdlib-406/listLabels.resi | stdlib-406/pervasives.cmj $bsc others +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/parsing.cmj : cc_cmi stdlib-406/parsing.res | stdlib-406/array.cmj stdlib-406/lexing.cmj stdlib-406/obj.cmj stdlib-406/parsing.cmi $bsc others +o stdlib-406/parsing.cmi : cc stdlib-406/parsing.resi | stdlib-406/lexing.cmi stdlib-406/obj.cmi stdlib-406/pervasives.cmj $bsc others o stdlib-406/pervasivesU.cmj : cc_cmi stdlib-406/pervasivesU.res | stdlib-406/pervasivesU.cmi $bsc others o stdlib-406/pervasivesU.cmi : cc stdlib-406/pervasivesU.resi | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/queue.cmj : cc_cmi stdlib-406/queue.ml | stdlib-406/queue.cmi $bsc others -o stdlib-406/queue.cmi : cc stdlib-406/queue.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/random.cmj : cc_cmi stdlib-406/random.ml | stdlib-406/array.cmj stdlib-406/char.cmj stdlib-406/digest.cmj stdlib-406/int32.cmj stdlib-406/int64.cmj stdlib-406/random.cmi stdlib-406/string.cmj $bsc others -o stdlib-406/random.cmi : cc stdlib-406/random.mli | stdlib-406/int32.cmi stdlib-406/int64.cmi stdlib-406/pervasives.cmj $bsc others -o stdlib-406/set.cmj : cc_cmi stdlib-406/set.ml | stdlib-406/list.cmj stdlib-406/set.cmi $bsc others -o stdlib-406/set.cmi : cc stdlib-406/set.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/setLabels.cmi stdlib-406/setLabels.cmj : cc stdlib-406/setLabels.ml | stdlib-406/list.cmj stdlib-406/pervasives.cmj $bsc others -o stdlib-406/sort.cmj : cc_cmi stdlib-406/sort.ml | stdlib-406/array.cmj stdlib-406/sort.cmi $bsc others -o stdlib-406/sort.cmi : cc stdlib-406/sort.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/stack.cmj : cc_cmi stdlib-406/stack.ml | stdlib-406/list.cmj stdlib-406/stack.cmi $bsc others -o stdlib-406/stack.cmi : cc stdlib-406/stack.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/stdLabels.cmj : cc_cmi stdlib-406/stdLabels.ml | stdlib-406/arrayLabels.cmj stdlib-406/bytesLabels.cmj stdlib-406/listLabels.cmj stdlib-406/stdLabels.cmi stdlib-406/stringLabels.cmj $bsc others -o stdlib-406/stdLabels.cmi : cc stdlib-406/stdLabels.mli | stdlib-406/arrayLabels.cmi stdlib-406/bytesLabels.cmi stdlib-406/listLabels.cmi stdlib-406/pervasives.cmj stdlib-406/stringLabels.cmi $bsc others -o stdlib-406/stream.cmj : cc_cmi stdlib-406/stream.ml | stdlib-406/bytes.cmj stdlib-406/lazy.cmj stdlib-406/list.cmj stdlib-406/stream.cmi stdlib-406/string.cmj $bsc others -o stdlib-406/stream.cmi : cc stdlib-406/stream.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/string.cmj : cc_cmi stdlib-406/string.ml | stdlib-406/bytes.cmj stdlib-406/string.cmi $bsc others -o stdlib-406/string.cmi : cc stdlib-406/string.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/stringLabels.cmj : cc_cmi stdlib-406/stringLabels.ml | stdlib-406/bytes.cmj stdlib-406/stringLabels.cmi $bsc others -o stdlib-406/stringLabels.cmi : cc stdlib-406/stringLabels.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/sys.cmj : cc_cmi stdlib-406/sys.ml | stdlib-406/sys.cmi $bsc others -o stdlib-406/sys.cmi : cc stdlib-406/sys.mli | stdlib-406/pervasives.cmj $bsc others -o stdlib-406/uchar.cmj : cc_cmi stdlib-406/uchar.ml | stdlib-406/char.cmj stdlib-406/uchar.cmi $bsc others -o stdlib-406/uchar.cmi : cc stdlib-406/uchar.mli | 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 stdlib-406/string.cmj $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 +o stdlib-406/sort.cmj : cc_cmi stdlib-406/sort.res | stdlib-406/array.cmj stdlib-406/sort.cmi $bsc others +o stdlib-406/sort.cmi : cc stdlib-406/sort.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/stack.cmj : cc_cmi stdlib-406/stack.res | stdlib-406/list.cmj stdlib-406/stack.cmi $bsc others +o stdlib-406/stack.cmi : cc stdlib-406/stack.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/stdLabels.cmj : cc_cmi stdlib-406/stdLabels.res | stdlib-406/arrayLabels.cmj stdlib-406/bytesLabels.cmj stdlib-406/listLabels.cmj stdlib-406/stdLabels.cmi stdlib-406/stringLabels.cmj $bsc others +o stdlib-406/stdLabels.cmi : cc stdlib-406/stdLabels.resi | stdlib-406/arrayLabels.cmi stdlib-406/bytesLabels.cmi stdlib-406/listLabels.cmi stdlib-406/pervasives.cmj stdlib-406/stringLabels.cmi $bsc others +o stdlib-406/stream.cmj : cc_cmi stdlib-406/stream.res | stdlib-406/bytes.cmj stdlib-406/lazy.cmj stdlib-406/list.cmj stdlib-406/stream.cmi stdlib-406/string.cmj $bsc others +o stdlib-406/stream.cmi : cc stdlib-406/stream.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/string.cmj : cc_cmi stdlib-406/string.res | stdlib-406/bytes.cmj stdlib-406/string.cmi $bsc others +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/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-406/sys.cmj : cc_cmi stdlib-406/sys.res | stdlib-406/sys.cmi $bsc others +o stdlib-406/sys.cmi : cc stdlib-406/sys.resi | stdlib-406/pervasives.cmj $bsc others +o stdlib-406/uchar.cmj : cc_cmi stdlib-406/uchar.res | stdlib-406/char.cmj stdlib-406/uchar.cmi $bsc others +o stdlib-406/uchar.cmi : cc stdlib-406/uchar.resi | stdlib-406/pervasives.cmj $bsc others o $stdlib : phony stdlib-406/pervasives.cmi stdlib-406/pervasives.cmj stdlib-406/arg.cmi stdlib-406/arg.cmj stdlib-406/array.cmi stdlib-406/array.cmj stdlib-406/arrayLabels.cmi stdlib-406/arrayLabels.cmj stdlib-406/buffer.cmi stdlib-406/buffer.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/filename.cmi stdlib-406/filename.cmj stdlib-406/genlex.cmi stdlib-406/genlex.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/lexing.cmi stdlib-406/lexing.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/parsing.cmi stdlib-406/parsing.cmj stdlib-406/pervasivesU.cmi stdlib-406/pervasivesU.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 stdlib-406/sys.cmi stdlib-406/sys.cmj stdlib-406/uchar.cmi stdlib-406/uchar.cmj diff --git a/jscomp/stdlib-406/set.ml b/jscomp/stdlib-406/set.ml deleted file mode 100644 index b3cbda47d2..0000000000 --- a/jscomp/stdlib-406/set.ml +++ /dev/null @@ -1,526 +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. *) -(* *) -(**************************************************************************) - -(* Sets over ordered types *) - -module type OrderedType = - sig - type t - val compare: t -> t -> int - end - -module type S = - sig - type elt - type t - val empty: t - val is_empty: t -> bool - val mem: elt -> t -> bool - val add: elt -> t -> t - val singleton: elt -> t - val remove: elt -> t -> t - val union: t -> t -> t - val inter: t -> t -> t - val diff: t -> t -> t - val compare: t -> t -> int - val equal: t -> t -> bool - val subset: t -> t -> bool - val iter: (elt -> unit) -> t -> unit - val map: (elt -> elt) -> t -> t - val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a - val for_all: (elt -> bool) -> t -> bool - val exists: (elt -> bool) -> t -> bool - val filter: (elt -> bool) -> t -> t - val partition: (elt -> bool) -> t -> t * t - val cardinal: t -> int - val elements: t -> elt list - val min_elt: t -> elt - val min_elt_opt: t -> elt option - val max_elt: t -> elt - val max_elt_opt: t -> elt option - val choose: t -> elt - val choose_opt: t -> elt option - val split: elt -> t -> t * bool * t - val find: elt -> t -> elt - val find_opt: elt -> t -> elt option - val find_first: (elt -> bool) -> t -> elt - val find_first_opt: (elt -> bool) -> t -> elt option - val find_last: (elt -> bool) -> t -> elt - val find_last_opt: (elt -> bool) -> t -> elt option - val of_list: elt list -> t - end - -module Make(Ord: OrderedType) = - struct - type elt = Ord.t - type t = Empty | Node of {l:t; v:elt; r:t; h:int} - - (* Sets are represented by balanced binary trees (the heights of the - children differ by at most 2 *) - - let height = function - Empty -> 0 - | Node {h} -> h - - (* Creates a new node with left son l, value v and right son r. - We must have all elements of l < v < all elements of r. - l and r must be balanced and | height l - height r | <= 2. - Inline expansion of height for better speed. *) - - let create l v r = - let hl = match l with Empty -> 0 | Node {h} -> h in - let hr = match r with Empty -> 0 | Node {h} -> h in - Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - (* Same as create, but performs one step of rebalancing if necessary. - Assumes l and r balanced and | height l - height r | <= 3. - Inline expansion of create for better speed in the most frequent case - where no rebalancing is required. *) - - let bal l v r = - let hl = match l with Empty -> 0 | Node {h} -> h in - let hr = match r with Empty -> 0 | Node {h} -> h in - if hl > hr + 2 then begin - match l with - Empty -> invalid_arg "Set.bal" - | Node{l=ll; v=lv; r=lr} -> - if height ll >= height lr then - create ll lv (create lr v r) - else begin - match lr with - Empty -> invalid_arg "Set.bal" - | Node{l=lrl; v=lrv; r=lrr}-> - create (create ll lv lrl) lrv (create lrr v r) - end - end else if hr > hl + 2 then begin - match r with - Empty -> invalid_arg "Set.bal" - | Node{l=rl; v=rv; r=rr} -> - if height rr >= height rl then - create (create l v rl) rv rr - else begin - match rl with - Empty -> invalid_arg "Set.bal" - | Node{l=rll; v=rlv; r=rlr} -> - create (create l v rll) rlv (create rlr rv rr) - end - end else - Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - (* Insertion of one element *) - - let rec add x = function - Empty -> Node{l=Empty; v=x; r=Empty; h=1} - | Node{l; v; r} as t -> - let c = Ord.compare x v in - if c = 0 then t else - if c < 0 then - let ll = add x l in - if l == ll then t else bal ll v r - else - let rr = add x r in - if r == rr then t else bal l v rr - - let singleton x = Node{l=Empty; v=x; r=Empty; h=1} - - (* Beware: those two functions assume that the added v is *strictly* - smaller (or bigger) than all the present elements in the tree; it - does not test for equality with the current min (or max) element. - Indeed, they are only used during the "join" operation which - respects this precondition. - *) - - let rec add_min_element x = function - | Empty -> singleton x - | Node {l; v; r} -> - bal (add_min_element x l) v r - - let rec add_max_element x = function - | Empty -> singleton x - | Node {l; v; r} -> - bal l v (add_max_element x r) - - (* Same as create and bal, but no assumptions are made on the - relative heights of l and r. *) - - let rec join l v r = - match (l, r) with - (Empty, _) -> add_min_element v r - | (_, Empty) -> add_max_element v l - | (Node{l=ll; v=lv; r=lr; h=lh}, Node{l=rl; v=rv; r=rr; h=rh}) -> - if lh > rh + 2 then bal ll lv (join lr v r) else - if rh > lh + 2 then bal (join l v rl) rv rr else - create l v r - - (* Smallest and greatest element of a set *) - - let rec min_elt = function - Empty -> raise Not_found - | Node{l=Empty; v} -> v - | Node{l} -> min_elt l - - let rec min_elt_opt = function - Empty -> None - | Node{l=Empty; v} -> Some v - | Node{l} -> min_elt_opt l - - let rec max_elt = function - Empty -> raise Not_found - | Node{v; r=Empty} -> v - | Node{r} -> max_elt r - - let rec max_elt_opt = function - Empty -> None - | Node{v; r=Empty} -> Some v - | Node{r} -> max_elt_opt r - - (* Remove the smallest element of the given set *) - - let rec remove_min_elt = function - Empty -> invalid_arg "Set.remove_min_elt" - | Node{l=Empty; r} -> r - | Node{l; v; r} -> bal (remove_min_elt l) v r - - (* Merge two trees l and r into one. - All elements of l must precede the elements of r. - Assume | height l - height r | <= 2. *) - - let merge t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> bal t1 (min_elt t2) (remove_min_elt t2) - - (* Merge two trees l and r into one. - All elements of l must precede the elements of r. - No assumption on the heights of l and r. *) - - let concat t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> join t1 (min_elt t2) (remove_min_elt t2) - - (* Splitting. split x s returns a triple (l, present, r) where - - l is the set of elements of s that are < x - - r is the set of elements of s that are > x - - present is false if s contains no element equal to x, - or true if s contains an element equal to x. *) - - let rec split x = function - Empty -> - (Empty, false, Empty) - | Node{l; v; r} -> - let c = Ord.compare x v in - if c = 0 then (l, true, r) - else if c < 0 then - let (ll, pres, rl) = split x l in (ll, pres, join rl v r) - else - let (lr, pres, rr) = split x r in (join l v lr, pres, rr) - - (* Implementation of the set operations *) - - let empty = Empty - - let is_empty = function Empty -> true | _ -> false - - let rec mem x = function - Empty -> false - | Node{l; v; r} -> - let c = Ord.compare x v in - c = 0 || mem x (if c < 0 then l else r) - - let rec remove x = function - Empty -> Empty - | (Node{l; v; r} as t) -> - let c = Ord.compare x v in - if c = 0 then merge l r - else - if c < 0 then - let ll = remove x l in - if l == ll then t - else bal ll v r - else - let rr = remove x r in - if r == rr then t - else bal l v rr - - let rec union s1 s2 = - match (s1, s2) with - (Empty, t2) -> t2 - | (t1, Empty) -> t1 - | (Node{l=l1; v=v1; r=r1; h=h1}, Node{l=l2; v=v2; r=r2; h=h2}) -> - if h1 >= h2 then - if h2 = 1 then add v2 s1 else begin - let (l2, _, r2) = split v1 s2 in - join (union l1 l2) v1 (union r1 r2) - end - else - if h1 = 1 then add v1 s2 else begin - let (l1, _, r1) = split v2 s1 in - join (union l1 l2) v2 (union r1 r2) - end - - let rec inter s1 s2 = - match (s1, s2) with - (Empty, _) -> Empty - | (_, Empty) -> Empty - | (Node{l=l1; v=v1; r=r1}, t2) -> - match split v1 t2 with - (l2, false, r2) -> - concat (inter l1 l2) (inter r1 r2) - | (l2, true, r2) -> - join (inter l1 l2) v1 (inter r1 r2) - - let rec diff s1 s2 = - match (s1, s2) with - (Empty, _) -> Empty - | (t1, Empty) -> t1 - | (Node{l=l1; v=v1; r=r1}, t2) -> - match split v1 t2 with - (l2, false, r2) -> - join (diff l1 l2) v1 (diff r1 r2) - | (l2, true, r2) -> - concat (diff l1 l2) (diff r1 r2) - - type enumeration = End | More of elt * t * enumeration - - let rec cons_enum s e = - match s with - Empty -> e - | Node{l; v; r} -> cons_enum l (More(v, r, e)) - - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, r1, e1), More(v2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 - then c - else compare_aux (cons_enum r1 e1) (cons_enum r2 e2) - - let compare s1 s2 = - compare_aux (cons_enum s1 End) (cons_enum s2 End) - - let equal s1 s2 = - compare s1 s2 = 0 - - let rec subset s1 s2 = - match (s1, s2) with - Empty, _ -> - true - | _, Empty -> - false - | Node {l=l1; v=v1; r=r1}, (Node {l=l2; v=v2; r=r2} as t2) -> - let c = Ord.compare v1 v2 in - if c = 0 then - subset l1 l2 && subset r1 r2 - else if c < 0 then - subset (Node {l=l1; v=v1; r=Empty; h=0}) l2 && subset r1 t2 - else - subset (Node {l=Empty; v=v1; r=r1; h=0}) r2 && subset l1 t2 - - let rec iter f = function - Empty -> () - | Node{l; v; r} -> iter f l; f v; iter f r - - let rec fold f s accu = - match s with - Empty -> accu - | Node{l; v; r} -> fold f r (f v (fold f l accu)) - - let rec for_all p = function - Empty -> true - | Node{l; v; r} -> p v && for_all p l && for_all p r - - let rec exists p = function - Empty -> false - | Node{l; v; r} -> p v || exists p l || exists p r - - let rec filter p = function - Empty -> Empty - | (Node{l; v; r}) as t -> - (* call [p] in the expected left-to-right order *) - let l' = filter p l in - let pv = p v in - let r' = filter p r in - if pv then - if l==l' && r==r' then t else join l' v r' - else concat l' r' - - let rec partition p = function - Empty -> (Empty, Empty) - | Node{l; v; r} -> - (* call [p] in the expected left-to-right order *) - let (lt, lf) = partition p l in - let pv = p v in - let (rt, rf) = partition p r in - if pv - then (join lt v rt, concat lf rf) - else (concat lt rt, join lf v rf) - - let rec cardinal = function - Empty -> 0 - | Node{l; r} -> cardinal l + 1 + cardinal r - - let rec elements_aux accu = function - Empty -> accu - | Node{l; v; r} -> elements_aux (v :: elements_aux accu r) l - - let elements s = - elements_aux [] s - - let choose = min_elt - - let choose_opt = min_elt_opt - - let rec find x = function - Empty -> raise Not_found - | Node{l; v; r} -> - let c = Ord.compare x v in - if c = 0 then v - else find x (if c < 0 then l else r) - - let rec find_first_aux v0 f = function - Empty -> - v0 - | Node{l; v; r} -> - if f v then - find_first_aux v f l - else - find_first_aux v0 f r - - let rec find_first f = function - Empty -> - raise Not_found - | Node{l; v; r} -> - if f v then - find_first_aux v f l - else - find_first f r - - let rec find_first_opt_aux v0 f = function - Empty -> - Some v0 - | Node{l; v; r} -> - if f v then - find_first_opt_aux v f l - else - find_first_opt_aux v0 f r - - let rec find_first_opt f = function - Empty -> - None - | Node{l; v; r} -> - if f v then - find_first_opt_aux v f l - else - find_first_opt f r - - let rec find_last_aux v0 f = function - Empty -> - v0 - | Node{l; v; r} -> - if f v then - find_last_aux v f r - else - find_last_aux v0 f l - - let rec find_last f = function - Empty -> - raise Not_found - | Node{l; v; r} -> - if f v then - find_last_aux v f r - else - find_last f l - - let rec find_last_opt_aux v0 f = function - Empty -> - Some v0 - | Node{l; v; r} -> - if f v then - find_last_opt_aux v f r - else - find_last_opt_aux v0 f l - - let rec find_last_opt f = function - Empty -> - None - | Node{l; v; r} -> - if f v then - find_last_opt_aux v f r - else - find_last_opt f l - - let rec find_opt x = function - Empty -> None - | Node{l; v; r} -> - let c = Ord.compare x v in - if c = 0 then Some v - else find_opt x (if c < 0 then l else r) - - let try_join l v r = - (* [join l v r] can only be called when (elements of l < v < - elements of r); use [try_join l v r] when this property may - not hold, but you hope it does hold in the common case *) - if (l = Empty || Ord.compare (max_elt l) v < 0) - && (r = Empty || Ord.compare v (min_elt r) < 0) - then join l v r - else union l (add v r) - - let rec map f = function - | Empty -> Empty - | Node{l; v; r} as t -> - (* enforce left-to-right evaluation order *) - let l' = map f l in - let v' = f v in - let r' = map f r in - if l == l' && v == v' && r == r' then t - else try_join l' v' r' - - let of_sorted_list l = - let rec sub n l = - match n, l with - | 0, l -> Empty, l - | 1, x0 :: l -> Node {l=Empty; v=x0; r=Empty; h=1}, l - | 2, x0 :: x1 :: l -> - Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; r=Empty; h=2}, l - | 3, x0 :: x1 :: x2 :: l -> - Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; - r=Node{l=Empty; v=x2; r=Empty; h=1}; h=2}, l - | n, l -> - let nl = n / 2 in - let left, l = sub nl l in - match l with - | [] -> assert false - | mid :: l -> - let right, l = sub (n - nl - 1) l in - create left mid right, l - in - fst (sub (List.length l) l) - - let of_list l = - match l with - | [] -> empty - | [x0] -> singleton x0 - | [x0; x1] -> add x1 (singleton x0) - | [x0; x1; x2] -> add x2 (add x1 (singleton x0)) - | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0))) - | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) - | _ -> of_sorted_list (List.sort_uniq Ord.compare l) - end diff --git a/jscomp/stdlib-406/set.mli b/jscomp/stdlib-406/set.mli deleted file mode 100644 index ef61e1a7ee..0000000000 --- a/jscomp/stdlib-406/set.mli +++ /dev/null @@ -1,266 +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. *) -(* *) -(**************************************************************************) - -(** Sets over ordered types. - - This module implements the set data structure, given a total ordering - function over the set elements. All operations over sets - are purely applicative (no side-effects). - The implementation uses balanced binary trees, and is therefore - reasonably efficient: insertion and membership take time - logarithmic in the size of the set, for instance. - - The {!Make} functor constructs implementations for any type, given a - [compare] function. - For instance: - {[ - module IntPairs = - struct - type t = int * int - let compare (x0,y0) (x1,y1) = - match Pervasives.compare x0 x1 with - 0 -> Pervasives.compare y0 y1 - | c -> c - end - - module PairsSet = Set.Make(IntPairs) - - let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13)) - ]} - - This creates a new module [PairsSet], with a new type [PairsSet.t] - of sets of [int * int]. -*) - -module type OrderedType = - sig - type t - (** The type of the set elements. *) - - val compare : t -> t -> int - (** A total ordering function over the set elements. - This is a two-argument function [f] such that - [f e1 e2] is zero if the elements [e1] and [e2] are equal, - [f e1 e2] is strictly negative if [e1] is smaller than [e2], - and [f e1 e2] is strictly positive if [e1] is greater than [e2]. - Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. *) - end -(** Input signature of the functor {!Set.Make}. *) - -module type S = - sig - type elt - (** The type of the set elements. *) - - type t - (** The type of sets. *) - - val empty: t - (** The empty set. *) - - val is_empty: t -> bool - (** Test whether a set is empty or not. *) - - val mem: elt -> t -> bool - (** [mem x s] tests whether [x] belongs to the set [s]. *) - - val add: elt -> t -> t - (** [add x s] returns a set containing all elements of [s], - plus [x]. If [x] was already in [s], [s] is returned unchanged - (the result of the function is then physically equal to [s]). - @before 4.03 Physical equality was not ensured. *) - - val singleton: elt -> t - (** [singleton x] returns the one-element set containing only [x]. *) - - val remove: elt -> t -> t - (** [remove x s] returns a set containing all elements of [s], - except [x]. If [x] was not in [s], [s] is returned unchanged - (the result of the function is then physically equal to [s]). - @before 4.03 Physical equality was not ensured. *) - - val union: t -> t -> t - (** Set union. *) - - val inter: t -> t -> t - (** Set intersection. *) - - val diff: t -> t -> t - (** Set difference. *) - - val compare: t -> t -> int - (** Total ordering between sets. Can be used as the ordering function - for doing sets of sets. *) - - val equal: t -> t -> bool - (** [equal s1 s2] tests whether the sets [s1] and [s2] are - equal, that is, contain equal elements. *) - - val subset: t -> t -> bool - (** [subset s1 s2] tests whether the set [s1] is a subset of - the set [s2]. *) - - val iter: (elt -> unit) -> t -> unit - (** [iter f s] applies [f] in turn to all elements of [s]. - The elements of [s] are presented to [f] in increasing order - with respect to the ordering over the type of the elements. *) - - val map: (elt -> elt) -> t -> t - (** [map f s] is the set whose elements are [f a0],[f a1]... [f - aN], where [a0],[a1]...[aN] are the elements of [s]. - - The elements are passed to [f] in increasing order - with respect to the ordering over the type of the elements. - - If no element of [s] is changed by [f], [s] is returned - unchanged. (If each output of [f] is physically equal to its - input, the returned set is physically equal to [s].) - @since 4.04.0 *) - - val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a - (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], - where [x1 ... xN] are the elements of [s], in increasing order. *) - - val for_all: (elt -> bool) -> t -> bool - (** [for_all p s] checks if all elements of the set - satisfy the predicate [p]. *) - - val exists: (elt -> bool) -> t -> bool - (** [exists p s] checks if at least one element of - the set satisfies the predicate [p]. *) - - val filter: (elt -> bool) -> t -> t - (** [filter p s] returns the set of all elements in [s] - that satisfy predicate [p]. If [p] satisfies every element in [s], - [s] is returned unchanged (the result of the function is then - physically equal to [s]). - @before 4.03 Physical equality was not ensured.*) - - val partition: (elt -> bool) -> t -> t * t - (** [partition p s] returns a pair of sets [(s1, s2)], where - [s1] is the set of all the elements of [s] that satisfy the - predicate [p], and [s2] is the set of all the elements of - [s] that do not satisfy [p]. *) - - val cardinal: t -> int - (** Return the number of elements of a set. *) - - val elements: t -> elt list - (** Return the list of all elements of the given set. - The returned list is sorted in increasing order with respect - to the ordering [Ord.compare], where [Ord] is the argument - given to {!Set.Make}. *) - - val min_elt: t -> elt - (** Return the smallest element of the given set - (with respect to the [Ord.compare] ordering), or raise - [Not_found] if the set is empty. *) - - val min_elt_opt: t -> elt option - (** Return the smallest element of the given set - (with respect to the [Ord.compare] ordering), or [None] - if the set is empty. - @since 4.05 - *) - - val max_elt: t -> elt - (** Same as {!Set.S.min_elt}, but returns the largest element of the - given set. *) - - val max_elt_opt: t -> elt option - (** Same as {!Set.S.min_elt_opt}, but returns the largest element of the - given set. - @since 4.05 - *) - - val choose: t -> elt - (** Return one element of the given set, or raise [Not_found] if - the set is empty. Which element is chosen is unspecified, - but equal elements will be chosen for equal sets. *) - - val choose_opt: t -> elt option - (** Return one element of the given set, or [None] if - the set is empty. Which element is chosen is unspecified, - but equal elements will be chosen for equal sets. - @since 4.05 - *) - - val split: elt -> t -> t * bool * t - (** [split x s] returns a triple [(l, present, r)], where - [l] is the set of elements of [s] that are - strictly less than [x]; - [r] is the set of elements of [s] that are - strictly greater than [x]; - [present] is [false] if [s] contains no element equal to [x], - or [true] if [s] contains an element equal to [x]. *) - - val find: elt -> t -> elt - (** [find x s] returns the element of [s] equal to [x] (according - to [Ord.compare]), or raise [Not_found] if no such element - exists. - @since 4.01.0 *) - - val find_opt: elt -> t -> elt option - (** [find_opt x s] returns the element of [s] equal to [x] (according - to [Ord.compare]), or [None] if no such element - exists. - @since 4.05 *) - - val find_first: (elt -> bool) -> t -> elt - (** [find_first f s], where [f] is a monotonically increasing function, - returns the lowest element [e] of [s] such that [f e], - or raises [Not_found] if no such element exists. - - For example, [find_first (fun e -> Ord.compare e x >= 0) s] will return - the first element [e] of [s] where [Ord.compare e x >= 0] (intuitively: - [e >= x]), or raise [Not_found] if [x] is greater than any element of - [s]. - - @since 4.05 - *) - - val find_first_opt: (elt -> bool) -> t -> elt option - (** [find_first_opt f s], where [f] is a monotonically increasing function, - returns an option containing the lowest element [e] of [s] such that - [f e], or [None] if no such element exists. - @since 4.05 - *) - - val find_last: (elt -> bool) -> t -> elt - (** [find_last f s], where [f] is a monotonically decreasing function, - returns the highest element [e] of [s] such that [f e], - or raises [Not_found] if no such element exists. - @since 4.05 - *) - - val find_last_opt: (elt -> bool) -> t -> elt option - (** [find_last_opt f s], where [f] is a monotonically decreasing function, - returns an option containing the highest element [e] of [s] such that - [f e], or [None] if no such element exists. - @since 4.05 - *) - - val of_list: elt list -> t - (** [of_list l] creates a set from a list of elements. - This is usually more efficient than folding [add] over the list, - except perhaps for lists with many duplicated elements. - @since 4.02.0 *) - end -(** Output signature of the functor {!Set.Make}. *) - -module Make (Ord : OrderedType) : S with type elt = Ord.t -(** Functor building an implementation of the set structure - given a totally ordered type. *) diff --git a/jscomp/stdlib-406/set.res b/jscomp/stdlib-406/set.res new file mode 100644 index 0000000000..49d30edd63 --- /dev/null +++ b/jscomp/stdlib-406/set.res @@ -0,0 +1,711 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Sets over ordered types */ + +module type OrderedType = { + type t + let compare: (t, t) => int +} + +module type S = { + type elt + type 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: (elt => unit, t) => unit + let map: (elt => elt, t) => t + let fold: ((elt, 'a) => 'a, t, 'a) => 'a + let for_all: (elt => bool, t) => bool + let exists: (elt => bool, t) => bool + let filter: (elt => bool, t) => t + let partition: (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: (elt => bool, t) => elt + let find_first_opt: (elt => bool, t) => option + let find_last: (elt => bool, t) => elt + let find_last_opt: (elt => bool, t) => option + let of_list: list => t +} + +module Make = (Ord: OrderedType) => { + type elt = Ord.t + type rec t = Empty | Node({l: t, v: elt, r: t, h: int}) + + /* Sets are represented by balanced binary trees (the heights of the + children differ by at most 2 */ + + let height = param => + switch param { + | Empty => 0 + | Node({h}) => h + } + + /* Creates a new node with left son l, value v and right son r. + We must have all elements of l < v < all elements of r. + l and r must be balanced and | height l - height r | <= 2. + Inline expansion of height for better speed. */ + + let create = (l, v, r) => { + let hl = switch l { + | Empty => 0 + | Node({h}) => h + } + let hr = switch r { + | Empty => 0 + | Node({h}) => h + } + Node({ + l, + v, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + + /* Same as create, but performs one step of rebalancing if necessary. + Assumes l and r balanced and | height l - height r | <= 3. + Inline expansion of create for better speed in the most frequent case + where no rebalancing is required. */ + + let bal = (l, v, r) => { + let hl = switch l { + | Empty => 0 + | Node({h}) => h + } + let hr = switch r { + | Empty => 0 + | Node({h}) => h + } + if hl > hr + 2 { + switch l { + | Empty => invalid_arg("Set.bal") + | Node({l: ll, v: lv, r: lr}) => + if height(ll) >= height(lr) { + create(ll, lv, create(lr, v, r)) + } else { + switch lr { + | Empty => invalid_arg("Set.bal") + | Node({l: lrl, v: lrv, r: lrr}) => create(create(ll, lv, lrl), lrv, create(lrr, v, r)) + } + } + } + } else if hr > hl + 2 { + switch r { + | Empty => invalid_arg("Set.bal") + | Node({l: rl, v: rv, r: rr}) => + if height(rr) >= height(rl) { + create(create(l, v, rl), rv, rr) + } else { + switch rl { + | Empty => invalid_arg("Set.bal") + | Node({l: rll, v: rlv, r: rlr}) => create(create(l, v, rll), rlv, create(rlr, rv, rr)) + } + } + } + } else { + Node({ + l, + v, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + } + + /* Insertion of one element */ + + let rec add = (x, param) => + switch param { + | Empty => Node({l: Empty, v: x, r: Empty, h: 1}) + | Node({l, v, r}) as t => + let c = Ord.compare(x, v) + if c == 0 { + t + } else if c < 0 { + let ll = add(x, l) + if l === ll { + t + } else { + bal(ll, v, r) + } + } else { + let rr = add(x, r) + if r === rr { + t + } else { + bal(l, v, rr) + } + } + } + + let singleton = x => Node({l: Empty, v: x, r: Empty, h: 1}) + + /* Beware: those two functions assume that the added v is *strictly* + smaller (or bigger) than all the present elements in the tree; it + does not test for equality with the current min (or max) element. + Indeed, they are only used during the "join" operation which + respects this precondition. + */ + + let rec add_min_element = (x, param) => + switch param { + | Empty => singleton(x) + | Node({l, v, r}) => bal(add_min_element(x, l), v, r) + } + + let rec add_max_element = (x, param) => + switch param { + | Empty => singleton(x) + | Node({l, v, r}) => bal(l, v, add_max_element(x, r)) + } + + /* Same as create and bal, but no assumptions are made on the + relative heights of l and r. */ + + let rec join = (l, v, r) => + switch (l, r) { + | (Empty, _) => add_min_element(v, r) + | (_, Empty) => add_max_element(v, l) + | (Node({l: ll, v: lv, r: lr, h: lh}), Node({l: rl, v: rv, r: rr, h: rh})) => + if lh > rh + 2 { + bal(ll, lv, join(lr, v, r)) + } else if rh > lh + 2 { + bal(join(l, v, rl), rv, rr) + } else { + create(l, v, r) + } + } + + /* Smallest and greatest element of a set */ + + let rec min_elt = param => + switch param { + | Empty => raise(Not_found) + | Node({l: Empty, v}) => v + | Node({l}) => min_elt(l) + } + + let rec min_elt_opt = param => + switch param { + | Empty => None + | Node({l: Empty, v}) => Some(v) + | Node({l}) => min_elt_opt(l) + } + + let rec max_elt = param => + switch param { + | Empty => raise(Not_found) + | Node({v, r: Empty}) => v + | Node({r}) => max_elt(r) + } + + let rec max_elt_opt = param => + switch param { + | Empty => None + | Node({v, r: Empty}) => Some(v) + | Node({r}) => max_elt_opt(r) + } + + /* Remove the smallest element of the given set */ + + let rec remove_min_elt = param => + switch param { + | Empty => invalid_arg("Set.remove_min_elt") + | Node({l: Empty, r}) => r + | Node({l, v, r}) => bal(remove_min_elt(l), v, r) + } + + /* Merge two trees l and r into one. + All elements of l must precede the elements of r. + Assume | height l - height r | <= 2. */ + + let merge = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => bal(t1, min_elt(t2), remove_min_elt(t2)) + } + + /* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. */ + + let concat = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => join(t1, min_elt(t2), remove_min_elt(t2)) + } + + /* Splitting. split x s returns a triple (l, present, r) where + - l is the set of elements of s that are < x + - r is the set of elements of s that are > x + - present is false if s contains no element equal to x, + or true if s contains an element equal to x. */ + + let rec split = (x, param) => + switch param { + | Empty => (Empty, false, Empty) + | Node({l, v, r}) => + let c = Ord.compare(x, v) + if c == 0 { + (l, true, r) + } else if c < 0 { + let (ll, pres, rl) = split(x, l) + (ll, pres, join(rl, v, r)) + } else { + let (lr, pres, rr) = split(x, r) + (join(l, v, lr), pres, rr) + } + } + + /* Implementation of the set operations */ + + let empty = Empty + + let is_empty = param => + switch param { + | Empty => true + | _ => false + } + + let rec mem = (x, param) => + switch param { + | Empty => false + | Node({l, v, r}) => + let c = Ord.compare(x, v) + c == 0 || + mem( + x, + if c < 0 { + l + } else { + r + }, + ) + } + + let rec remove = (x, param) => + switch param { + | Empty => Empty + | Node({l, v, r}) as t => + let c = Ord.compare(x, v) + if c == 0 { + merge(l, r) + } else if c < 0 { + let ll = remove(x, l) + if l === ll { + t + } else { + bal(ll, v, r) + } + } else { + let rr = remove(x, r) + if r === rr { + t + } else { + bal(l, v, rr) + } + } + } + + let rec union = (s1, s2) => + switch (s1, s2) { + | (Empty, t2) => t2 + | (t1, Empty) => t1 + | (Node({l: l1, v: v1, r: r1, h: h1}), Node({l: l2, v: v2, r: r2, h: h2})) => + if h1 >= h2 { + if h2 == 1 { + add(v2, s1) + } else { + let (l2, _, r2) = split(v1, s2) + join(union(l1, l2), v1, union(r1, r2)) + } + } else if h1 == 1 { + add(v1, s2) + } else { + let (l1, _, r1) = split(v2, s1) + join(union(l1, l2), v2, union(r1, r2)) + } + } + + let rec inter = (s1, s2) => + switch (s1, s2) { + | (Empty, _) => Empty + | (_, Empty) => Empty + | (Node({l: l1, v: v1, r: r1}), t2) => + switch split(v1, t2) { + | (l2, false, r2) => concat(inter(l1, l2), inter(r1, r2)) + | (l2, true, r2) => join(inter(l1, l2), v1, inter(r1, r2)) + } + } + + let rec diff = (s1, s2) => + switch (s1, s2) { + | (Empty, _) => Empty + | (t1, Empty) => t1 + | (Node({l: l1, v: v1, r: r1}), t2) => + switch split(v1, t2) { + | (l2, false, r2) => join(diff(l1, l2), v1, diff(r1, r2)) + | (l2, true, r2) => concat(diff(l1, l2), diff(r1, r2)) + } + } + + type rec enumeration = End | More(elt, t, enumeration) + + let rec cons_enum = (s, e) => + switch s { + | Empty => e + | Node({l, v, r}) => cons_enum(l, More(v, r, e)) + } + + let rec compare_aux = (e1, e2) => + switch (e1, e2) { + | (End, End) => 0 + | (End, _) => -1 + | (_, End) => 1 + | (More(v1, r1, e1), More(v2, r2, e2)) => + let c = Ord.compare(v1, v2) + if c != 0 { + c + } else { + compare_aux(cons_enum(r1, e1), cons_enum(r2, e2)) + } + } + + let compare = (s1, s2) => compare_aux(cons_enum(s1, End), cons_enum(s2, End)) + + let equal = (s1, s2) => compare(s1, s2) == 0 + + let rec subset = (s1, s2) => + switch (s1, s2) { + | (Empty, _) => true + | (_, Empty) => false + | (Node({l: l1, v: v1, r: r1}), Node({l: l2, v: v2, r: r2}) as t2) => + let c = Ord.compare(v1, v2) + if c == 0 { + subset(l1, l2) && subset(r1, r2) + } else if c < 0 { + subset(Node({l: l1, v: v1, r: Empty, h: 0}), l2) && subset(r1, t2) + } else { + subset(Node({l: Empty, v: v1, r: r1, h: 0}), r2) && subset(l1, t2) + } + } + + let rec iter = (f, param) => + switch param { + | Empty => () + | Node({l, v, r}) => + iter(f, l) + f(v) + iter(f, r) + } + + let rec fold = (f, s, accu) => + switch s { + | Empty => accu + | Node({l, v, r}) => fold(f, r, f(v, fold(f, l, accu))) + } + + let rec for_all = (p, param) => + switch param { + | Empty => true + | Node({l, v, r}) => p(v) && (for_all(p, l) && for_all(p, r)) + } + + let rec exists = (p, param) => + switch param { + | Empty => false + | Node({l, v, r}) => p(v) || (exists(p, l) || exists(p, r)) + } + + let rec filter = (p, param) => + switch param { + | Empty => Empty + | Node({l, v, r}) as t => + /* call [p] in the expected left-to-right order */ + let l' = filter(p, l) + let pv = p(v) + let r' = filter(p, r) + if pv { + if l === l' && r === r' { + t + } else { + join(l', v, r') + } + } else { + concat(l', r') + } + } + + let rec partition = (p, param) => + switch param { + | Empty => (Empty, Empty) + | Node({l, v, r}) => + /* call [p] in the expected left-to-right order */ + let (lt, lf) = partition(p, l) + let pv = p(v) + let (rt, rf) = partition(p, r) + if pv { + (join(lt, v, rt), concat(lf, rf)) + } else { + (concat(lt, rt), join(lf, v, rf)) + } + } + + let rec cardinal = param => + switch param { + | Empty => 0 + | Node({l, r}) => cardinal(l) + 1 + cardinal(r) + } + + let rec elements_aux = (accu, param) => + switch param { + | Empty => accu + | Node({l, v, r}) => elements_aux(list{v, ...elements_aux(accu, r)}, l) + } + + let elements = s => elements_aux(list{}, s) + + let choose = min_elt + + let choose_opt = min_elt_opt + + let rec find = (x, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, r}) => + let c = Ord.compare(x, v) + if c == 0 { + v + } else { + find( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let rec find_first_aux = (v0, f, param) => + switch param { + | Empty => v0 + | Node({l, v, r}) => + if f(v) { + find_first_aux(v, f, l) + } else { + find_first_aux(v0, f, r) + } + } + + let rec find_first = (f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, r}) => + if f(v) { + find_first_aux(v, f, l) + } else { + find_first(f, r) + } + } + + let rec find_first_opt_aux = (v0, f, param) => + switch param { + | Empty => Some(v0) + | Node({l, v, r}) => + if f(v) { + find_first_opt_aux(v, f, l) + } else { + find_first_opt_aux(v0, f, r) + } + } + + let rec find_first_opt = (f, param) => + switch param { + | Empty => None + | Node({l, v, r}) => + if f(v) { + find_first_opt_aux(v, f, l) + } else { + find_first_opt(f, r) + } + } + + let rec find_last_aux = (v0, f, param) => + switch param { + | Empty => v0 + | Node({l, v, r}) => + if f(v) { + find_last_aux(v, f, r) + } else { + find_last_aux(v0, f, l) + } + } + + let rec find_last = (f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, r}) => + if f(v) { + find_last_aux(v, f, r) + } else { + find_last(f, l) + } + } + + let rec find_last_opt_aux = (v0, f, param) => + switch param { + | Empty => Some(v0) + | Node({l, v, r}) => + if f(v) { + find_last_opt_aux(v, f, r) + } else { + find_last_opt_aux(v0, f, l) + } + } + + let rec find_last_opt = (f, param) => + switch param { + | Empty => None + | Node({l, v, r}) => + if f(v) { + find_last_opt_aux(v, f, r) + } else { + find_last_opt(f, l) + } + } + + let rec find_opt = (x, param) => + switch param { + | Empty => None + | Node({l, v, r}) => + let c = Ord.compare(x, v) + if c == 0 { + Some(v) + } else { + find_opt( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let try_join = (l, v, r) => + /* [join l v r] can only be called when (elements of l < v < + elements of r); use [try_join l v r] when this property may + not hold, but you hope it does hold in the common case */ + if ( + (l == Empty || Ord.compare(max_elt(l), v) < 0) && + (r == Empty || Ord.compare(v, min_elt(r)) < 0) + ) { + join(l, v, r) + } else { + union(l, add(v, r)) + } + + let rec map = (f, param) => + switch param { + | Empty => Empty + | Node({l, v, r}) as t => + /* enforce left-to-right evaluation order */ + let l' = map(f, l) + let v' = f(v) + let r' = map(f, r) + if l === l' && (v === v' && r === r') { + t + } else { + try_join(l', v', r') + } + } + + let of_sorted_list = l => { + let rec sub = (n, l) => + switch (n, l) { + | (0, l) => (Empty, l) + | (1, list{x0, ...l}) => (Node({l: Empty, v: x0, r: Empty, h: 1}), l) + | (2, list{x0, x1, ...l}) => ( + Node({l: Node({l: Empty, v: x0, r: Empty, h: 1}), v: x1, r: Empty, h: 2}), + l, + ) + | (3, list{x0, x1, x2, ...l}) => ( + Node({ + l: Node({l: Empty, v: x0, r: Empty, h: 1}), + v: x1, + r: Node({l: Empty, v: x2, r: Empty, h: 1}), + h: 2, + }), + l, + ) + | (n, l) => + let nl = n / 2 + let (left, l) = sub(nl, l) + switch l { + | list{} => assert(false) + | list{mid, ...l} => + let (right, l) = sub(n - nl - 1, l) + (create(left, mid, right), l) + } + } + + fst(sub(List.length(l), l)) + } + + let of_list = l => + switch l { + | list{} => empty + | list{x0} => singleton(x0) + | list{x0, x1} => add(x1, singleton(x0)) + | list{x0, x1, x2} => add(x2, add(x1, singleton(x0))) + | list{x0, x1, x2, x3} => add(x3, add(x2, add(x1, singleton(x0)))) + | list{x0, x1, x2, x3, x4} => add(x4, add(x3, add(x2, add(x1, singleton(x0))))) + | _ => of_sorted_list(List.sort_uniq(Ord.compare, l)) + } +} diff --git a/jscomp/stdlib-406/set.resi b/jscomp/stdlib-406/set.resi new file mode 100644 index 0000000000..5620e66b33 --- /dev/null +++ b/jscomp/stdlib-406/set.resi @@ -0,0 +1,264 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Sets over ordered types. + + This module implements the set data structure, given a total ordering + function over the set elements. All operations over sets + are purely applicative (no side-effects). + The implementation uses balanced binary trees, and is therefore + reasonably efficient: insertion and membership take time + logarithmic in the size of the set, for instance. + + The {!Make} functor constructs implementations for any type, given a + [compare] function. + For instance: + {[ + module IntPairs = + struct + type t = int * int + let compare (x0,y0) (x1,y1) = + match Pervasives.compare x0 x1 with + 0 -> Pervasives.compare y0 y1 + | c -> c + end + + module PairsSet = Set.Make(IntPairs) + + let m = PairsSet.(empty |> add (2,3) |> add (5,7) |> add (11,13)) + ]} + + This creates a new module [PairsSet], with a new type [PairsSet.t] + of sets of [int * int]. +") + +@ocaml.doc(" Input signature of the functor {!Set.Make}. ") +module type OrderedType = { + @ocaml.doc(" The type of the set elements. ") + type t + + @ocaml.doc(" A total ordering function over the set elements. + This is a two-argument function [f] such that + [f e1 e2] is zero if the elements [e1] and [e2] are equal, + [f e1 e2] is strictly negative if [e1] is smaller than [e2], + and [f e1 e2] is strictly positive if [e1] is greater than [e2]. + Example: a suitable ordering function is the generic structural + comparison function {!Pervasives.compare}. ") + let compare: (t, t) => int +} + +@ocaml.doc(" Output signature of the functor {!Set.Make}. ") +module type S = { + @ocaml.doc(" The type of the set elements. ") + type elt + + @ocaml.doc(" The type of sets. ") + type t + + @ocaml.doc(" The empty set. ") + let empty: t + + @ocaml.doc(" Test whether a set is empty or not. ") + let is_empty: t => bool + + @ocaml.doc(" [mem x s] tests whether [x] belongs to the set [s]. ") + let mem: (elt, t) => bool + + @ocaml.doc(" [add x s] returns a set containing all elements of [s], + plus [x]. If [x] was already in [s], [s] is returned unchanged + (the result of the function is then physically equal to [s]). + @before 4.03 Physical equality was not ensured. ") + let add: (elt, t) => t + + @ocaml.doc(" [singleton x] returns the one-element set containing only [x]. ") + let singleton: elt => t + + @ocaml.doc(" [remove x s] returns a set containing all elements of [s], + except [x]. If [x] was not in [s], [s] is returned unchanged + (the result of the function is then physically equal to [s]). + @before 4.03 Physical equality was not ensured. ") + let remove: (elt, t) => t + + @ocaml.doc(" Set union. ") + let union: (t, t) => t + + @ocaml.doc(" Set intersection. ") + let inter: (t, t) => t + + @ocaml.doc(" Set difference. ") + let diff: (t, t) => t + + @ocaml.doc(" Total ordering between sets. Can be used as the ordering function + for doing sets of sets. ") + let compare: (t, t) => int + + @ocaml.doc(" [equal s1 s2] tests whether the sets [s1] and [s2] are + equal, that is, contain equal elements. ") + let equal: (t, t) => bool + + @ocaml.doc(" [subset s1 s2] tests whether the set [s1] is a subset of + the set [s2]. ") + let subset: (t, t) => bool + + @ocaml.doc(" [iter f s] applies [f] in turn to all elements of [s]. + The elements of [s] are presented to [f] in increasing order + with respect to the ordering over the type of the elements. ") + let iter: (elt => unit, t) => unit + + @ocaml.doc(" [map f s] is the set whose elements are [f a0],[f a1]... [f + aN], where [a0],[a1]...[aN] are the elements of [s]. + + The elements are passed to [f] in increasing order + with respect to the ordering over the type of the elements. + + If no element of [s] is changed by [f], [s] is returned + unchanged. (If each output of [f] is physically equal to its + input, the returned set is physically equal to [s].) + @since 4.04.0 ") + let map: (elt => elt, t) => t + + @ocaml.doc(" [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], + where [x1 ... xN] are the elements of [s], in increasing order. ") + let fold: ((elt, 'a) => 'a, t, 'a) => 'a + + @ocaml.doc(" [for_all p s] checks if all elements of the set + satisfy the predicate [p]. ") + let for_all: (elt => bool, t) => bool + + @ocaml.doc(" [exists p s] checks if at least one element of + the set satisfies the predicate [p]. ") + let exists: (elt => bool, t) => bool + + @ocaml.doc(" [filter p s] returns the set of all elements in [s] + that satisfy predicate [p]. If [p] satisfies every element in [s], + [s] is returned unchanged (the result of the function is then + physically equal to [s]). + @before 4.03 Physical equality was not ensured.") + let filter: (elt => bool, t) => t + + @ocaml.doc(" [partition p s] returns a pair of sets [(s1, s2)], where + [s1] is the set of all the elements of [s] that satisfy the + predicate [p], and [s2] is the set of all the elements of + [s] that do not satisfy [p]. ") + let partition: (elt => bool, t) => (t, t) + + @ocaml.doc(" Return the number of elements of a set. ") + let cardinal: t => int + + @ocaml.doc(" Return the list of all elements of the given set. + The returned list is sorted in increasing order with respect + to the ordering [Ord.compare], where [Ord] is the argument + given to {!Set.Make}. ") + let elements: t => list + + @ocaml.doc(" Return the smallest element of the given set + (with respect to the [Ord.compare] ordering), or raise + [Not_found] if the set is empty. ") + let min_elt: t => elt + + @ocaml.doc(" Return the smallest element of the given set + (with respect to the [Ord.compare] ordering), or [None] + if the set is empty. + @since 4.05 + ") + let min_elt_opt: t => option + + @ocaml.doc(" Same as {!Set.S.min_elt}, but returns the largest element of the + given set. ") + let max_elt: t => elt + + @ocaml.doc(" Same as {!Set.S.min_elt_opt}, but returns the largest element of the + given set. + @since 4.05 + ") + let max_elt_opt: t => option + + @ocaml.doc(" Return one element of the given set, or raise [Not_found] if + the set is empty. Which element is chosen is unspecified, + but equal elements will be chosen for equal sets. ") + let choose: t => elt + + @ocaml.doc(" Return one element of the given set, or [None] if + the set is empty. Which element is chosen is unspecified, + but equal elements will be chosen for equal sets. + @since 4.05 + ") + let choose_opt: t => option + + @ocaml.doc(" [split x s] returns a triple [(l, present, r)], where + [l] is the set of elements of [s] that are + strictly less than [x]; + [r] is the set of elements of [s] that are + strictly greater than [x]; + [present] is [false] if [s] contains no element equal to [x], + or [true] if [s] contains an element equal to [x]. ") + let split: (elt, t) => (t, bool, t) + + @ocaml.doc(" [find x s] returns the element of [s] equal to [x] (according + to [Ord.compare]), or raise [Not_found] if no such element + exists. + @since 4.01.0 ") + let find: (elt, t) => elt + + @ocaml.doc(" [find_opt x s] returns the element of [s] equal to [x] (according + to [Ord.compare]), or [None] if no such element + exists. + @since 4.05 ") + let find_opt: (elt, t) => option + + @ocaml.doc(" [find_first f s], where [f] is a monotonically increasing function, + returns the lowest element [e] of [s] such that [f e], + or raises [Not_found] if no such element exists. + + For example, [find_first (fun e -> Ord.compare e x >= 0) s] will return + the first element [e] of [s] where [Ord.compare e x >= 0] (intuitively: + [e >= x]), or raise [Not_found] if [x] is greater than any element of + [s]. + + @since 4.05 + ") + let find_first: (elt => bool, t) => elt + + @ocaml.doc(" [find_first_opt f s], where [f] is a monotonically increasing function, + returns an option containing the lowest element [e] of [s] such that + [f e], or [None] if no such element exists. + @since 4.05 + ") + let find_first_opt: (elt => bool, t) => option + + @ocaml.doc(" [find_last f s], where [f] is a monotonically decreasing function, + returns the highest element [e] of [s] such that [f e], + or raises [Not_found] if no such element exists. + @since 4.05 + ") + let find_last: (elt => bool, t) => elt + + @ocaml.doc(" [find_last_opt f s], where [f] is a monotonically decreasing function, + returns an option containing the highest element [e] of [s] such that + [f e], or [None] if no such element exists. + @since 4.05 + ") + let find_last_opt: (elt => bool, t) => option + + @ocaml.doc(" [of_list l] creates a set from a list of elements. + This is usually more efficient than folding [add] over the list, + except perhaps for lists with many duplicated elements. + @since 4.02.0 ") + let of_list: list => t +} + +@ocaml.doc(" Functor building an implementation of the set structure + given a totally ordered type. ") +module Make: (Ord: OrderedType) => (S with type elt = Ord.t) diff --git a/jscomp/stdlib-406/setLabels.ml b/jscomp/stdlib-406/setLabels.ml deleted file mode 100644 index e2e8f316b3..0000000000 --- a/jscomp/stdlib-406/setLabels.ml +++ /dev/null @@ -1,526 +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. *) -(* *) -(**************************************************************************) - -(* Sets over ordered types *) - -module type OrderedType = - sig - type t - val compare: t -> t -> int - end - -module type S = - sig - type elt - type t - val empty: t - val is_empty: t -> bool - val mem: elt -> t -> bool - val add: elt -> t -> t - val singleton: elt -> t - val remove: elt -> t -> t - val union: t -> t -> t - val inter: t -> t -> t - val diff: t -> t -> t - val compare: t -> t -> int - val equal: t -> t -> bool - val subset: t -> t -> bool - val iter: f:(elt -> unit) -> t -> unit - val map: f:(elt -> elt) -> t -> t - val fold: f:(elt -> 'a -> 'a) -> t -> init:'a -> 'a - val for_all: f:(elt -> bool) -> t -> bool - val exists: f:(elt -> bool) -> t -> bool - val filter: f:(elt -> bool) -> t -> t - val partition: f:(elt -> bool) -> t -> t * t - val cardinal: t -> int - val elements: t -> elt list - val min_elt: t -> elt - val min_elt_opt: t -> elt option - val max_elt: t -> elt - val max_elt_opt: t -> elt option - val choose: t -> elt - val choose_opt: t -> elt option - val split: elt -> t -> t * bool * t - val find: elt -> t -> elt - val find_opt: elt -> t -> elt option - val find_first: f:(elt -> bool) -> t -> elt - val find_first_opt: f:(elt -> bool) -> t -> elt option - val find_last: f:(elt -> bool) -> t -> elt - val find_last_opt: f:(elt -> bool) -> t -> elt option - val of_list: elt list -> t - end - -module Make(Ord: OrderedType) = - struct - type elt = Ord.t - type t = Empty | Node of {l:t; v:elt; r:t; h:int} - - (* Sets are represented by balanced binary trees (the heights of the - children differ by at most 2 *) - - let height = function - Empty -> 0 - | Node {h} -> h - - (* Creates a new node with left son l, value v and right son r. - We must have all elements of l < v < all elements of r. - l and r must be balanced and | height l - height r | <= 2. - Inline expansion of height for better speed. *) - - let create l v r = - let hl = match l with Empty -> 0 | Node {h} -> h in - let hr = match r with Empty -> 0 | Node {h} -> h in - Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - (* Same as create, but performs one step of rebalancing if necessary. - Assumes l and r balanced and | height l - height r | <= 3. - Inline expansion of create for better speed in the most frequent case - where no rebalancing is required. *) - - let bal l v r = - let hl = match l with Empty -> 0 | Node {h} -> h in - let hr = match r with Empty -> 0 | Node {h} -> h in - if hl > hr + 2 then begin - match l with - Empty -> invalid_arg "Set.bal" - | Node{l=ll; v=lv; r=lr} -> - if height ll >= height lr then - create ll lv (create lr v r) - else begin - match lr with - Empty -> invalid_arg "Set.bal" - | Node{l=lrl; v=lrv; r=lrr}-> - create (create ll lv lrl) lrv (create lrr v r) - end - end else if hr > hl + 2 then begin - match r with - Empty -> invalid_arg "Set.bal" - | Node{l=rl; v=rv; r=rr} -> - if height rr >= height rl then - create (create l v rl) rv rr - else begin - match rl with - Empty -> invalid_arg "Set.bal" - | Node{l=rll; v=rlv; r=rlr} -> - create (create l v rll) rlv (create rlr rv rr) - end - end else - Node{l; v; r; h=(if hl >= hr then hl + 1 else hr + 1)} - - (* Insertion of one element *) - - let rec add x = function - Empty -> Node{l=Empty; v=x; r=Empty; h=1} - | Node{l; v; r} as t -> - let c = Ord.compare x v in - if c = 0 then t else - if c < 0 then - let ll = add x l in - if l == ll then t else bal ll v r - else - let rr = add x r in - if r == rr then t else bal l v rr - - let singleton x = Node{l=Empty; v=x; r=Empty; h=1} - - (* Beware: those two functions assume that the added v is *strictly* - smaller (or bigger) than all the present elements in the tree; it - does not test for equality with the current min (or max) element. - Indeed, they are only used during the "join" operation which - respects this precondition. - *) - - let rec add_min_element x = function - | Empty -> singleton x - | Node {l; v; r} -> - bal (add_min_element x l) v r - - let rec add_max_element x = function - | Empty -> singleton x - | Node {l; v; r} -> - bal l v (add_max_element x r) - - (* Same as create and bal, but no assumptions are made on the - relative heights of l and r. *) - - let rec join l v r = - match (l, r) with - (Empty, _) -> add_min_element v r - | (_, Empty) -> add_max_element v l - | (Node{l=ll; v=lv; r=lr; h=lh}, Node{l=rl; v=rv; r=rr; h=rh}) -> - if lh > rh + 2 then bal ll lv (join lr v r) else - if rh > lh + 2 then bal (join l v rl) rv rr else - create l v r - - (* Smallest and greatest element of a set *) - - let rec min_elt = function - Empty -> raise Not_found - | Node{l=Empty; v} -> v - | Node{l} -> min_elt l - - let rec min_elt_opt = function - Empty -> None - | Node{l=Empty; v} -> Some v - | Node{l} -> min_elt_opt l - - let rec max_elt = function - Empty -> raise Not_found - | Node{v; r=Empty} -> v - | Node{r} -> max_elt r - - let rec max_elt_opt = function - Empty -> None - | Node{v; r=Empty} -> Some v - | Node{r} -> max_elt_opt r - - (* Remove the smallest element of the given set *) - - let rec remove_min_elt = function - Empty -> invalid_arg "Set.remove_min_elt" - | Node{l=Empty; r} -> r - | Node{l; v; r} -> bal (remove_min_elt l) v r - - (* Merge two trees l and r into one. - All elements of l must precede the elements of r. - Assume | height l - height r | <= 2. *) - - let merge t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> bal t1 (min_elt t2) (remove_min_elt t2) - - (* Merge two trees l and r into one. - All elements of l must precede the elements of r. - No assumption on the heights of l and r. *) - - let concat t1 t2 = - match (t1, t2) with - (Empty, t) -> t - | (t, Empty) -> t - | (_, _) -> join t1 (min_elt t2) (remove_min_elt t2) - - (* Splitting. split x s returns a triple (l, present, r) where - - l is the set of elements of s that are < x - - r is the set of elements of s that are > x - - present is false if s contains no element equal to x, - or true if s contains an element equal to x. *) - - let rec split x = function - Empty -> - (Empty, false, Empty) - | Node{l; v; r} -> - let c = Ord.compare x v in - if c = 0 then (l, true, r) - else if c < 0 then - let (ll, pres, rl) = split x l in (ll, pres, join rl v r) - else - let (lr, pres, rr) = split x r in (join l v lr, pres, rr) - - (* Implementation of the set operations *) - - let empty = Empty - - let is_empty = function Empty -> true | _ -> false - - let rec mem x = function - Empty -> false - | Node{l; v; r} -> - let c = Ord.compare x v in - c = 0 || mem x (if c < 0 then l else r) - - let rec remove x = function - Empty -> Empty - | (Node{l; v; r} as t) -> - let c = Ord.compare x v in - if c = 0 then merge l r - else - if c < 0 then - let ll = remove x l in - if l == ll then t - else bal ll v r - else - let rr = remove x r in - if r == rr then t - else bal l v rr - - let rec union s1 s2 = - match (s1, s2) with - (Empty, t2) -> t2 - | (t1, Empty) -> t1 - | (Node{l=l1; v=v1; r=r1; h=h1}, Node{l=l2; v=v2; r=r2; h=h2}) -> - if h1 >= h2 then - if h2 = 1 then add v2 s1 else begin - let (l2, _, r2) = split v1 s2 in - join (union l1 l2) v1 (union r1 r2) - end - else - if h1 = 1 then add v1 s2 else begin - let (l1, _, r1) = split v2 s1 in - join (union l1 l2) v2 (union r1 r2) - end - - let rec inter s1 s2 = - match (s1, s2) with - (Empty, _) -> Empty - | (_, Empty) -> Empty - | (Node{l=l1; v=v1; r=r1}, t2) -> - match split v1 t2 with - (l2, false, r2) -> - concat (inter l1 l2) (inter r1 r2) - | (l2, true, r2) -> - join (inter l1 l2) v1 (inter r1 r2) - - let rec diff s1 s2 = - match (s1, s2) with - (Empty, _) -> Empty - | (t1, Empty) -> t1 - | (Node{l=l1; v=v1; r=r1}, t2) -> - match split v1 t2 with - (l2, false, r2) -> - join (diff l1 l2) v1 (diff r1 r2) - | (l2, true, r2) -> - concat (diff l1 l2) (diff r1 r2) - - type enumeration = End | More of elt * t * enumeration - - let rec cons_enum s e = - match s with - Empty -> e - | Node{l; v; r} -> cons_enum l (More(v, r, e)) - - let rec compare_aux e1 e2 = - match (e1, e2) with - (End, End) -> 0 - | (End, _) -> -1 - | (_, End) -> 1 - | (More(v1, r1, e1), More(v2, r2, e2)) -> - let c = Ord.compare v1 v2 in - if c <> 0 - then c - else compare_aux (cons_enum r1 e1) (cons_enum r2 e2) - - let compare s1 s2 = - compare_aux (cons_enum s1 End) (cons_enum s2 End) - - let equal s1 s2 = - compare s1 s2 = 0 - - let rec subset s1 s2 = - match (s1, s2) with - Empty, _ -> - true - | _, Empty -> - false - | Node {l=l1; v=v1; r=r1}, (Node {l=l2; v=v2; r=r2} as t2) -> - let c = Ord.compare v1 v2 in - if c = 0 then - subset l1 l2 && subset r1 r2 - else if c < 0 then - subset (Node {l=l1; v=v1; r=Empty; h=0}) l2 && subset r1 t2 - else - subset (Node {l=Empty; v=v1; r=r1; h=0}) r2 && subset l1 t2 - - let rec iter ~f = function - Empty -> () - | Node{l; v; r} -> iter ~f l; f v; iter ~f r - - let rec fold ~f s ~init:accu = - match s with - Empty -> accu - | Node{l; v; r} -> fold ~f r ~init:(f v (fold ~f l ~init:accu)) - - let rec for_all ~f:p = function - Empty -> true - | Node{l; v; r} -> p v && for_all ~f:p l && for_all ~f:p r - - let rec exists ~f:p = function - Empty -> false - | Node{l; v; r} -> p v || exists ~f:p l || exists ~f:p r - - let rec filter ~f:p = function - Empty -> Empty - | (Node{l; v; r}) as t -> - (* call [p] in the expected left-to-right order *) - let l' = filter ~f:p l in - let pv = p v in - let r' = filter ~f:p r in - if pv then - if l==l' && r==r' then t else join l' v r' - else concat l' r' - - let rec partition ~f:p = function - Empty -> (Empty, Empty) - | Node{l; v; r} -> - (* call [p] in the expected left-to-right order *) - let (lt, lf) = partition ~f:p l in - let pv = p v in - let (rt, rf) = partition ~f:p r in - if pv - then (join lt v rt, concat lf rf) - else (concat lt rt, join lf v rf) - - let rec cardinal = function - Empty -> 0 - | Node{l; r} -> cardinal l + 1 + cardinal r - - let rec elements_aux accu = function - Empty -> accu - | Node{l; v; r} -> elements_aux (v :: elements_aux accu r) l - - let elements s = - elements_aux [] s - - let choose = min_elt - - let choose_opt = min_elt_opt - - let rec find x = function - Empty -> raise Not_found - | Node{l; v; r} -> - let c = Ord.compare x v in - if c = 0 then v - else find x (if c < 0 then l else r) - - let rec find_first_aux v0 f = function - Empty -> - v0 - | Node{l; v; r} -> - if f v then - find_first_aux v f l - else - find_first_aux v0 f r - - let rec find_first ~f = function - Empty -> - raise Not_found - | Node{l; v; r} -> - if f v then - find_first_aux v f l - else - find_first ~f r - - let rec find_first_opt_aux v0 f = function - Empty -> - Some v0 - | Node{l; v; r} -> - if f v then - find_first_opt_aux v f l - else - find_first_opt_aux v0 f r - - let rec find_first_opt ~f = function - Empty -> - None - | Node{l; v; r} -> - if f v then - find_first_opt_aux v f l - else - find_first_opt ~f r - - let rec find_last_aux v0 f = function - Empty -> - v0 - | Node{l; v; r} -> - if f v then - find_last_aux v f r - else - find_last_aux v0 f l - - let rec find_last ~f = function - Empty -> - raise Not_found - | Node{l; v; r} -> - if f v then - find_last_aux v f r - else - find_last ~f l - - let rec find_last_opt_aux v0 f = function - Empty -> - Some v0 - | Node{l; v; r} -> - if f v then - find_last_opt_aux v f r - else - find_last_opt_aux v0 f l - - let rec find_last_opt ~f = function - Empty -> - None - | Node{l; v; r} -> - if f v then - find_last_opt_aux v f r - else - find_last_opt ~f l - - let rec find_opt x = function - Empty -> None - | Node{l; v; r} -> - let c = Ord.compare x v in - if c = 0 then Some v - else find_opt x (if c < 0 then l else r) - - let try_join l v r = - (* [join l v r] can only be called when (elements of l < v < - elements of r); use [try_join l v r] when this property may - not hold, but you hope it does hold in the common case *) - if (l = Empty || Ord.compare (max_elt l) v < 0) - && (r = Empty || Ord.compare v (min_elt r) < 0) - then join l v r - else union l (add v r) - - let rec map ~f = function - | Empty -> Empty - | Node{l; v; r} as t -> - (* enforce left-to-right evaluation order *) - let l' = map ~f l in - let v' = f v in - let r' = map ~f r in - if l == l' && v == v' && r == r' then t - else try_join l' v' r' - - let of_sorted_list l = - let rec sub n l = - match n, l with - | 0, l -> Empty, l - | 1, x0 :: l -> Node {l=Empty; v=x0; r=Empty; h=1}, l - | 2, x0 :: x1 :: l -> - Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; r=Empty; h=2}, l - | 3, x0 :: x1 :: x2 :: l -> - Node{l=Node{l=Empty; v=x0; r=Empty; h=1}; v=x1; - r=Node{l=Empty; v=x2; r=Empty; h=1}; h=2}, l - | n, l -> - let nl = n / 2 in - let left, l = sub nl l in - match l with - | [] -> assert false - | mid :: l -> - let right, l = sub (n - nl - 1) l in - create left mid right, l - in - fst (sub (List.length l) l) - - let of_list l = - match l with - | [] -> empty - | [x0] -> singleton x0 - | [x0; x1] -> add x1 (singleton x0) - | [x0; x1; x2] -> add x2 (add x1 (singleton x0)) - | [x0; x1; x2; x3] -> add x3 (add x2 (add x1 (singleton x0))) - | [x0; x1; x2; x3; x4] -> add x4 (add x3 (add x2 (add x1 (singleton x0)))) - | _ -> of_sorted_list (List.sort_uniq Ord.compare l) - end diff --git a/jscomp/stdlib-406/setLabels.res b/jscomp/stdlib-406/setLabels.res new file mode 100644 index 0000000000..4e0ed5e2c8 --- /dev/null +++ b/jscomp/stdlib-406/setLabels.res @@ -0,0 +1,711 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Sets over ordered types */ + +module type OrderedType = { + type t + let compare: (t, t) => int +} + +module type S = { + type elt + type 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) => { + type elt = Ord.t + type rec t = Empty | Node({l: t, v: elt, r: t, h: int}) + + /* Sets are represented by balanced binary trees (the heights of the + children differ by at most 2 */ + + let height = param => + switch param { + | Empty => 0 + | Node({h}) => h + } + + /* Creates a new node with left son l, value v and right son r. + We must have all elements of l < v < all elements of r. + l and r must be balanced and | height l - height r | <= 2. + Inline expansion of height for better speed. */ + + let create = (l, v, r) => { + let hl = switch l { + | Empty => 0 + | Node({h}) => h + } + let hr = switch r { + | Empty => 0 + | Node({h}) => h + } + Node({ + l, + v, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + + /* Same as create, but performs one step of rebalancing if necessary. + Assumes l and r balanced and | height l - height r | <= 3. + Inline expansion of create for better speed in the most frequent case + where no rebalancing is required. */ + + let bal = (l, v, r) => { + let hl = switch l { + | Empty => 0 + | Node({h}) => h + } + let hr = switch r { + | Empty => 0 + | Node({h}) => h + } + if hl > hr + 2 { + switch l { + | Empty => invalid_arg("Set.bal") + | Node({l: ll, v: lv, r: lr}) => + if height(ll) >= height(lr) { + create(ll, lv, create(lr, v, r)) + } else { + switch lr { + | Empty => invalid_arg("Set.bal") + | Node({l: lrl, v: lrv, r: lrr}) => create(create(ll, lv, lrl), lrv, create(lrr, v, r)) + } + } + } + } else if hr > hl + 2 { + switch r { + | Empty => invalid_arg("Set.bal") + | Node({l: rl, v: rv, r: rr}) => + if height(rr) >= height(rl) { + create(create(l, v, rl), rv, rr) + } else { + switch rl { + | Empty => invalid_arg("Set.bal") + | Node({l: rll, v: rlv, r: rlr}) => create(create(l, v, rll), rlv, create(rlr, rv, rr)) + } + } + } + } else { + Node({ + l, + v, + r, + h: if hl >= hr { + hl + 1 + } else { + hr + 1 + }, + }) + } + } + + /* Insertion of one element */ + + let rec add = (x, param) => + switch param { + | Empty => Node({l: Empty, v: x, r: Empty, h: 1}) + | Node({l, v, r}) as t => + let c = Ord.compare(x, v) + if c == 0 { + t + } else if c < 0 { + let ll = add(x, l) + if l === ll { + t + } else { + bal(ll, v, r) + } + } else { + let rr = add(x, r) + if r === rr { + t + } else { + bal(l, v, rr) + } + } + } + + let singleton = x => Node({l: Empty, v: x, r: Empty, h: 1}) + + /* Beware: those two functions assume that the added v is *strictly* + smaller (or bigger) than all the present elements in the tree; it + does not test for equality with the current min (or max) element. + Indeed, they are only used during the "join" operation which + respects this precondition. + */ + + let rec add_min_element = (x, param) => + switch param { + | Empty => singleton(x) + | Node({l, v, r}) => bal(add_min_element(x, l), v, r) + } + + let rec add_max_element = (x, param) => + switch param { + | Empty => singleton(x) + | Node({l, v, r}) => bal(l, v, add_max_element(x, r)) + } + + /* Same as create and bal, but no assumptions are made on the + relative heights of l and r. */ + + let rec join = (l, v, r) => + switch (l, r) { + | (Empty, _) => add_min_element(v, r) + | (_, Empty) => add_max_element(v, l) + | (Node({l: ll, v: lv, r: lr, h: lh}), Node({l: rl, v: rv, r: rr, h: rh})) => + if lh > rh + 2 { + bal(ll, lv, join(lr, v, r)) + } else if rh > lh + 2 { + bal(join(l, v, rl), rv, rr) + } else { + create(l, v, r) + } + } + + /* Smallest and greatest element of a set */ + + let rec min_elt = param => + switch param { + | Empty => raise(Not_found) + | Node({l: Empty, v}) => v + | Node({l}) => min_elt(l) + } + + let rec min_elt_opt = param => + switch param { + | Empty => None + | Node({l: Empty, v}) => Some(v) + | Node({l}) => min_elt_opt(l) + } + + let rec max_elt = param => + switch param { + | Empty => raise(Not_found) + | Node({v, r: Empty}) => v + | Node({r}) => max_elt(r) + } + + let rec max_elt_opt = param => + switch param { + | Empty => None + | Node({v, r: Empty}) => Some(v) + | Node({r}) => max_elt_opt(r) + } + + /* Remove the smallest element of the given set */ + + let rec remove_min_elt = param => + switch param { + | Empty => invalid_arg("Set.remove_min_elt") + | Node({l: Empty, r}) => r + | Node({l, v, r}) => bal(remove_min_elt(l), v, r) + } + + /* Merge two trees l and r into one. + All elements of l must precede the elements of r. + Assume | height l - height r | <= 2. */ + + let merge = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => bal(t1, min_elt(t2), remove_min_elt(t2)) + } + + /* Merge two trees l and r into one. + All elements of l must precede the elements of r. + No assumption on the heights of l and r. */ + + let concat = (t1, t2) => + switch (t1, t2) { + | (Empty, t) => t + | (t, Empty) => t + | (_, _) => join(t1, min_elt(t2), remove_min_elt(t2)) + } + + /* Splitting. split x s returns a triple (l, present, r) where + - l is the set of elements of s that are < x + - r is the set of elements of s that are > x + - present is false if s contains no element equal to x, + or true if s contains an element equal to x. */ + + let rec split = (x, param) => + switch param { + | Empty => (Empty, false, Empty) + | Node({l, v, r}) => + let c = Ord.compare(x, v) + if c == 0 { + (l, true, r) + } else if c < 0 { + let (ll, pres, rl) = split(x, l) + (ll, pres, join(rl, v, r)) + } else { + let (lr, pres, rr) = split(x, r) + (join(l, v, lr), pres, rr) + } + } + + /* Implementation of the set operations */ + + let empty = Empty + + let is_empty = param => + switch param { + | Empty => true + | _ => false + } + + let rec mem = (x, param) => + switch param { + | Empty => false + | Node({l, v, r}) => + let c = Ord.compare(x, v) + c == 0 || + mem( + x, + if c < 0 { + l + } else { + r + }, + ) + } + + let rec remove = (x, param) => + switch param { + | Empty => Empty + | Node({l, v, r}) as t => + let c = Ord.compare(x, v) + if c == 0 { + merge(l, r) + } else if c < 0 { + let ll = remove(x, l) + if l === ll { + t + } else { + bal(ll, v, r) + } + } else { + let rr = remove(x, r) + if r === rr { + t + } else { + bal(l, v, rr) + } + } + } + + let rec union = (s1, s2) => + switch (s1, s2) { + | (Empty, t2) => t2 + | (t1, Empty) => t1 + | (Node({l: l1, v: v1, r: r1, h: h1}), Node({l: l2, v: v2, r: r2, h: h2})) => + if h1 >= h2 { + if h2 == 1 { + add(v2, s1) + } else { + let (l2, _, r2) = split(v1, s2) + join(union(l1, l2), v1, union(r1, r2)) + } + } else if h1 == 1 { + add(v1, s2) + } else { + let (l1, _, r1) = split(v2, s1) + join(union(l1, l2), v2, union(r1, r2)) + } + } + + let rec inter = (s1, s2) => + switch (s1, s2) { + | (Empty, _) => Empty + | (_, Empty) => Empty + | (Node({l: l1, v: v1, r: r1}), t2) => + switch split(v1, t2) { + | (l2, false, r2) => concat(inter(l1, l2), inter(r1, r2)) + | (l2, true, r2) => join(inter(l1, l2), v1, inter(r1, r2)) + } + } + + let rec diff = (s1, s2) => + switch (s1, s2) { + | (Empty, _) => Empty + | (t1, Empty) => t1 + | (Node({l: l1, v: v1, r: r1}), t2) => + switch split(v1, t2) { + | (l2, false, r2) => join(diff(l1, l2), v1, diff(r1, r2)) + | (l2, true, r2) => concat(diff(l1, l2), diff(r1, r2)) + } + } + + type rec enumeration = End | More(elt, t, enumeration) + + let rec cons_enum = (s, e) => + switch s { + | Empty => e + | Node({l, v, r}) => cons_enum(l, More(v, r, e)) + } + + let rec compare_aux = (e1, e2) => + switch (e1, e2) { + | (End, End) => 0 + | (End, _) => -1 + | (_, End) => 1 + | (More(v1, r1, e1), More(v2, r2, e2)) => + let c = Ord.compare(v1, v2) + if c != 0 { + c + } else { + compare_aux(cons_enum(r1, e1), cons_enum(r2, e2)) + } + } + + let compare = (s1, s2) => compare_aux(cons_enum(s1, End), cons_enum(s2, End)) + + let equal = (s1, s2) => compare(s1, s2) == 0 + + let rec subset = (s1, s2) => + switch (s1, s2) { + | (Empty, _) => true + | (_, Empty) => false + | (Node({l: l1, v: v1, r: r1}), Node({l: l2, v: v2, r: r2}) as t2) => + let c = Ord.compare(v1, v2) + if c == 0 { + subset(l1, l2) && subset(r1, r2) + } else if c < 0 { + subset(Node({l: l1, v: v1, r: Empty, h: 0}), l2) && subset(r1, t2) + } else { + subset(Node({l: Empty, v: v1, r: r1, h: 0}), r2) && subset(l1, t2) + } + } + + let rec iter = (~f, param) => + switch param { + | Empty => () + | Node({l, v, r}) => + iter(~f, l) + f(v) + iter(~f, r) + } + + let rec fold = (~f, s, ~init as accu) => + switch s { + | Empty => accu + | Node({l, v, r}) => fold(~f, r, ~init=f(v, fold(~f, l, ~init=accu))) + } + + let rec for_all = (~f as p, param) => + switch param { + | Empty => true + | Node({l, v, r}) => p(v) && (for_all(~f=p, l) && for_all(~f=p, r)) + } + + let rec exists = (~f as p, param) => + switch param { + | Empty => false + | Node({l, v, r}) => p(v) || (exists(~f=p, l) || exists(~f=p, r)) + } + + let rec filter = (~f as p, param) => + switch param { + | Empty => Empty + | Node({l, v, r}) as t => + /* call [p] in the expected left-to-right order */ + let l' = filter(~f=p, l) + let pv = p(v) + let r' = filter(~f=p, r) + if pv { + if l === l' && r === r' { + t + } else { + join(l', v, r') + } + } else { + concat(l', r') + } + } + + let rec partition = (~f as p, param) => + switch param { + | Empty => (Empty, Empty) + | Node({l, v, r}) => + /* call [p] in the expected left-to-right order */ + let (lt, lf) = partition(~f=p, l) + let pv = p(v) + let (rt, rf) = partition(~f=p, r) + if pv { + (join(lt, v, rt), concat(lf, rf)) + } else { + (concat(lt, rt), join(lf, v, rf)) + } + } + + let rec cardinal = param => + switch param { + | Empty => 0 + | Node({l, r}) => cardinal(l) + 1 + cardinal(r) + } + + let rec elements_aux = (accu, param) => + switch param { + | Empty => accu + | Node({l, v, r}) => elements_aux(list{v, ...elements_aux(accu, r)}, l) + } + + let elements = s => elements_aux(list{}, s) + + let choose = min_elt + + let choose_opt = min_elt_opt + + let rec find = (x, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, r}) => + let c = Ord.compare(x, v) + if c == 0 { + v + } else { + find( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let rec find_first_aux = (v0, f, param) => + switch param { + | Empty => v0 + | Node({l, v, r}) => + if f(v) { + find_first_aux(v, f, l) + } else { + find_first_aux(v0, f, r) + } + } + + let rec find_first = (~f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, r}) => + if f(v) { + find_first_aux(v, f, l) + } else { + find_first(~f, r) + } + } + + let rec find_first_opt_aux = (v0, f, param) => + switch param { + | Empty => Some(v0) + | Node({l, v, r}) => + if f(v) { + find_first_opt_aux(v, f, l) + } else { + find_first_opt_aux(v0, f, r) + } + } + + let rec find_first_opt = (~f, param) => + switch param { + | Empty => None + | Node({l, v, r}) => + if f(v) { + find_first_opt_aux(v, f, l) + } else { + find_first_opt(~f, r) + } + } + + let rec find_last_aux = (v0, f, param) => + switch param { + | Empty => v0 + | Node({l, v, r}) => + if f(v) { + find_last_aux(v, f, r) + } else { + find_last_aux(v0, f, l) + } + } + + let rec find_last = (~f, param) => + switch param { + | Empty => raise(Not_found) + | Node({l, v, r}) => + if f(v) { + find_last_aux(v, f, r) + } else { + find_last(~f, l) + } + } + + let rec find_last_opt_aux = (v0, f, param) => + switch param { + | Empty => Some(v0) + | Node({l, v, r}) => + if f(v) { + find_last_opt_aux(v, f, r) + } else { + find_last_opt_aux(v0, f, l) + } + } + + let rec find_last_opt = (~f, param) => + switch param { + | Empty => None + | Node({l, v, r}) => + if f(v) { + find_last_opt_aux(v, f, r) + } else { + find_last_opt(~f, l) + } + } + + let rec find_opt = (x, param) => + switch param { + | Empty => None + | Node({l, v, r}) => + let c = Ord.compare(x, v) + if c == 0 { + Some(v) + } else { + find_opt( + x, + if c < 0 { + l + } else { + r + }, + ) + } + } + + let try_join = (l, v, r) => + /* [join l v r] can only be called when (elements of l < v < + elements of r); use [try_join l v r] when this property may + not hold, but you hope it does hold in the common case */ + if ( + (l == Empty || Ord.compare(max_elt(l), v) < 0) && + (r == Empty || Ord.compare(v, min_elt(r)) < 0) + ) { + join(l, v, r) + } else { + union(l, add(v, r)) + } + + let rec map = (~f, param) => + switch param { + | Empty => Empty + | Node({l, v, r}) as t => + /* enforce left-to-right evaluation order */ + let l' = map(~f, l) + let v' = f(v) + let r' = map(~f, r) + if l === l' && (v === v' && r === r') { + t + } else { + try_join(l', v', r') + } + } + + let of_sorted_list = l => { + let rec sub = (n, l) => + switch (n, l) { + | (0, l) => (Empty, l) + | (1, list{x0, ...l}) => (Node({l: Empty, v: x0, r: Empty, h: 1}), l) + | (2, list{x0, x1, ...l}) => ( + Node({l: Node({l: Empty, v: x0, r: Empty, h: 1}), v: x1, r: Empty, h: 2}), + l, + ) + | (3, list{x0, x1, x2, ...l}) => ( + Node({ + l: Node({l: Empty, v: x0, r: Empty, h: 1}), + v: x1, + r: Node({l: Empty, v: x2, r: Empty, h: 1}), + h: 2, + }), + l, + ) + | (n, l) => + let nl = n / 2 + let (left, l) = sub(nl, l) + switch l { + | list{} => assert(false) + | list{mid, ...l} => + let (right, l) = sub(n - nl - 1, l) + (create(left, mid, right), l) + } + } + + fst(sub(List.length(l), l)) + } + + let of_list = l => + switch l { + | list{} => empty + | list{x0} => singleton(x0) + | list{x0, x1} => add(x1, singleton(x0)) + | list{x0, x1, x2} => add(x2, add(x1, singleton(x0))) + | list{x0, x1, x2, x3} => add(x3, add(x2, add(x1, singleton(x0)))) + | list{x0, x1, x2, x3, x4} => add(x4, add(x3, add(x2, add(x1, singleton(x0))))) + | _ => of_sorted_list(List.sort_uniq(Ord.compare, l)) + } +} diff --git a/jscomp/stdlib-406/sort.ml b/jscomp/stdlib-406/sort.ml deleted file mode 100644 index 3e3b12e06d..0000000000 --- a/jscomp/stdlib-406/sort.ml +++ /dev/null @@ -1,99 +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. *) -(* *) -(**************************************************************************) - -(* Merging and sorting *) - -open Array - -let rec merge order l1 l2 = - match l1 with - [] -> l2 - | h1 :: t1 -> - match l2 with - [] -> l1 - | h2 :: t2 -> - if order h1 h2 - then h1 :: merge order t1 l2 - else h2 :: merge order l1 t2 - -let list order l = - let rec initlist = function - [] -> [] - | [e] -> [[e]] - | e1::e2::rest -> - (if order e1 e2 then [e1;e2] else [e2;e1]) :: initlist rest in - let rec merge2 = function - l1::l2::rest -> merge order l1 l2 :: merge2 rest - | x -> x in - let rec mergeall = function - [] -> [] - | [l] -> l - | llist -> mergeall (merge2 llist) in - mergeall(initlist l) - -let swap arr i j = - let tmp = unsafe_get arr i in - unsafe_set arr i (unsafe_get arr j); - unsafe_set arr j tmp - -(* There is a known performance bug in the code below. If you find - it, don't bother reporting it. You're not supposed to use this - module anyway. *) -let array cmp arr = - let rec qsort lo hi = - if hi - lo >= 6 then begin - let mid = (lo + hi) lsr 1 in - (* Select median value from among LO, MID, and HI. Rearrange - LO and HI so the three values are sorted. This lowers the - probability of picking a pathological pivot. It also - avoids extra comparisons on i and j in the two tight "while" - loops below. *) - if cmp (unsafe_get arr mid) (unsafe_get arr lo) then swap arr mid lo; - if cmp (unsafe_get arr hi) (unsafe_get arr mid) then begin - swap arr mid hi; - if cmp (unsafe_get arr mid) (unsafe_get arr lo) then swap arr mid lo - end; - let pivot = unsafe_get arr mid in - let i = ref (lo + 1) and j = ref (hi - 1) in - if not (cmp pivot (unsafe_get arr hi)) - || not (cmp (unsafe_get arr lo) pivot) - then raise (Invalid_argument "Sort.array"); - while !i < !j do - while not (cmp pivot (unsafe_get arr !i)) do incr i done; - while not (cmp (unsafe_get arr !j) pivot) do decr j done; - if !i < !j then swap arr !i !j; - incr i; decr j - done; - (* Recursion on smaller half, tail-call on larger half *) - if !j - lo <= hi - !i then begin - qsort lo !j; qsort !i hi - end else begin - qsort !i hi; qsort lo !j - end - end in - qsort 0 (Array.length arr - 1); - (* Finish sorting by insertion sort *) - for i = 1 to Array.length arr - 1 do - let val_i = (unsafe_get arr i) in - if not (cmp (unsafe_get arr (i - 1)) val_i) then begin - unsafe_set arr i (unsafe_get arr (i - 1)); - let j = ref (i - 1) in - while !j >= 1 && not (cmp (unsafe_get arr (!j - 1)) val_i) do - unsafe_set arr !j (unsafe_get arr (!j - 1)); - decr j - done; - unsafe_set arr !j val_i - end - done diff --git a/jscomp/stdlib-406/sort.mli b/jscomp/stdlib-406/sort.mli deleted file mode 100644 index 80ebad2600..0000000000 --- a/jscomp/stdlib-406/sort.mli +++ /dev/null @@ -1,44 +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. *) -(* *) -(**************************************************************************) - -(** Sorting and merging lists. - - @deprecated This module is obsolete and exists only for backward - compatibility. - The sorting functions in {!Array} and {!List} should be used instead. - The new functions are faster and use less memory. -*) - -val list : ('a -> 'a -> bool) -> 'a list -> 'a list - [@@ocaml.deprecated "Use List.sort instead."] -(** Sort a list in increasing order according to an ordering predicate. - The predicate should return [true] if its first argument is - less than or equal to its second argument. *) - -val array : ('a -> 'a -> bool) -> 'a array -> unit - [@@ocaml.deprecated "Use Array.sort instead."] -(** Sort an array in increasing order according to an - ordering predicate. - The predicate should return [true] if its first argument is - less than or equal to its second argument. - The array is sorted in place. *) - -val merge : ('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list - [@@ocaml.deprecated "Use List.merge instead."] -(** Merge two lists according to the given predicate. - Assuming the two argument lists are sorted according to the - predicate, [merge] returns a sorted list containing the elements - from the two lists. The behavior is undefined if the two - argument lists were not sorted. *) diff --git a/jscomp/stdlib-406/sort.res b/jscomp/stdlib-406/sort.res new file mode 100644 index 0000000000..ab1713a6ee --- /dev/null +++ b/jscomp/stdlib-406/sort.res @@ -0,0 +1,134 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Merging and sorting */ + +open Array + +let rec merge = (order, l1, l2) => + switch l1 { + | list{} => l2 + | list{h1, ...t1} => + switch l2 { + | list{} => l1 + | list{h2, ...t2} => + if order(h1, h2) { + list{h1, ...merge(order, t1, l2)} + } else { + list{h2, ...merge(order, l1, t2)} + } + } + } + +let list = (order, l) => { + let rec initlist = param => + switch param { + | list{} => list{} + | list{e} => list{list{e}} + | list{e1, e2, ...rest} => + list{ + if order(e1, e2) { + list{e1, e2} + } else { + list{e2, e1} + }, + ...initlist(rest), + } + } + let rec merge2 = param => + switch param { + | list{l1, l2, ...rest} => list{merge(order, l1, l2), ...merge2(rest)} + | x => x + } + let rec mergeall = param => + switch param { + | list{} => list{} + | list{l} => l + | llist => mergeall(merge2(llist)) + } + mergeall(initlist(l)) +} + +let swap = (arr, i, j) => { + let tmp = unsafe_get(arr, i) + unsafe_set(arr, i, unsafe_get(arr, j)) + unsafe_set(arr, j, tmp) +} + +/* There is a known performance bug in the code below. If you find + it, don't bother reporting it. You're not supposed to use this + module anyway. */ +let array = (cmp, arr) => { + let rec qsort = (lo, hi) => + if hi - lo >= 6 { + let mid = lsr(lo + hi, 1) + + /* Select median value from among LO, MID, and HI. Rearrange + LO and HI so the three values are sorted. This lowers the + probability of picking a pathological pivot. It also + avoids extra comparisons on i and j in the two tight "while" + loops below. */ + if cmp(unsafe_get(arr, mid), unsafe_get(arr, lo)) { + swap(arr, mid, lo) + } + if cmp(unsafe_get(arr, hi), unsafe_get(arr, mid)) { + swap(arr, mid, hi) + if cmp(unsafe_get(arr, mid), unsafe_get(arr, lo)) { + swap(arr, mid, lo) + } + } + let pivot = unsafe_get(arr, mid) + let i = ref(lo + 1) and j = ref(hi - 1) + if !cmp(pivot, unsafe_get(arr, hi)) || !cmp(unsafe_get(arr, lo), pivot) { + raise(Invalid_argument("Sort.array")) + } + while i.contents < j.contents { + while !cmp(pivot, unsafe_get(arr, i.contents)) { + incr(i) + } + while !cmp(unsafe_get(arr, j.contents), pivot) { + decr(j) + } + if i.contents < j.contents { + swap(arr, i.contents, j.contents) + } + incr(i) + decr(j) + } + + /* Recursion on smaller half, tail-call on larger half */ + if j.contents - lo <= hi - i.contents { + qsort(lo, j.contents) + qsort(i.contents, hi) + } else { + qsort(i.contents, hi) + qsort(lo, j.contents) + } + } + qsort(0, Array.length(arr) - 1) + /* Finish sorting by insertion sort */ + for i in 1 to Array.length(arr) - 1 { + let val_i = unsafe_get(arr, i) + if !cmp(unsafe_get(arr, i - 1), val_i) { + unsafe_set(arr, i, unsafe_get(arr, i - 1)) + let j = ref(i - 1) + while j.contents >= 1 && !cmp(unsafe_get(arr, j.contents - 1), val_i) { + unsafe_set(arr, j.contents, unsafe_get(arr, j.contents - 1)) + decr(j) + } + unsafe_set(arr, j.contents, val_i) + } + } +} diff --git a/jscomp/stdlib-406/sort.resi b/jscomp/stdlib-406/sort.resi new file mode 100644 index 0000000000..7b76e63d90 --- /dev/null +++ b/jscomp/stdlib-406/sort.resi @@ -0,0 +1,44 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Sorting and merging lists. + + @deprecated This module is obsolete and exists only for backward + compatibility. + The sorting functions in {!Array} and {!List} should be used instead. + The new functions are faster and use less memory. +") + +@ocaml.deprecated("Use List.sort instead.") +@ocaml.doc(" Sort a list in increasing order according to an ordering predicate. + The predicate should return [true] if its first argument is + less than or equal to its second argument. ") +let list: (('a, 'a) => bool, list<'a>) => list<'a> + +@ocaml.deprecated("Use Array.sort instead.") +@ocaml.doc(" Sort an array in increasing order according to an + ordering predicate. + The predicate should return [true] if its first argument is + less than or equal to its second argument. + The array is sorted in place. ") +let array: (('a, 'a) => bool, array<'a>) => unit + +@ocaml.deprecated("Use List.merge instead.") +@ocaml.doc(" Merge two lists according to the given predicate. + Assuming the two argument lists are sorted according to the + predicate, [merge] returns a sorted list containing the elements + from the two lists. The behavior is undefined if the two + argument lists were not sorted. ") +let merge: (('a, 'a) => bool, list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/stack.ml b/jscomp/stdlib-406/stack.ml deleted file mode 100644 index 21dad3e848..0000000000 --- a/jscomp/stdlib-406/stack.ml +++ /dev/null @@ -1,44 +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. *) -(* *) -(**************************************************************************) - -type 'a t = { mutable c : 'a list; mutable len : int; } - -exception Empty - -let create () = { c = []; len = 0; } - -let clear s = s.c <- []; s.len <- 0 - -let copy s = { c = s.c; len = s.len; } - -let push x s = s.c <- x :: s.c; s.len <- s.len + 1 - -let pop s = - match s.c with - | hd::tl -> s.c <- tl; s.len <- s.len - 1; hd - | [] -> raise Empty - -let top s = - match s.c with - | hd::_ -> hd - | [] -> raise Empty - -let is_empty s = (s.c = []) - -let length s = s.len - -let iter f s = List.iter f s.c - -let fold f acc s = List.fold_left f acc s.c diff --git a/jscomp/stdlib-406/stack.mli b/jscomp/stdlib-406/stack.mli deleted file mode 100644 index 4ce899536c..0000000000 --- a/jscomp/stdlib-406/stack.mli +++ /dev/null @@ -1,63 +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. *) -(* *) -(**************************************************************************) - -(** Last-in first-out stacks. - - This module implements stacks (LIFOs), with in-place modification. -*) - -type 'a t -(** The type of stacks containing elements of type ['a]. *) - -exception Empty -(** Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. *) - - -val create : unit -> 'a t -(** Return a new stack, initially empty. *) - -val push : 'a -> 'a t -> unit -(** [push x s] adds the element [x] at the top of stack [s]. *) - -val pop : 'a t -> 'a -(** [pop s] removes and returns the topmost element in stack [s], - or raises {!Empty} if the stack is empty. *) - -val top : 'a t -> 'a -(** [top s] returns the topmost element in stack [s], - or raises {!Empty} if the stack is empty. *) - -val clear : 'a t -> unit -(** Discard all elements from a stack. *) - -val copy : 'a t -> 'a t -(** Return a copy of the given stack. *) - -val is_empty : 'a t -> bool -(** Return [true] if the given stack is empty, [false] otherwise. *) - -val length : 'a t -> int -(** Return the number of elements in a stack. Time complexity O(1) *) - -val iter : ('a -> unit) -> 'a t -> unit -(** [iter f s] applies [f] in turn to all elements of [s], - from the element at the top of the stack to the element at the - bottom of the stack. The stack itself is unchanged. *) - -val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b -(** [fold f accu s] is [(f (... (f (f accu x1) x2) ...) xn)] - where [x1] is the top of the stack, [x2] the second element, - and [xn] the bottom element. The stack is unchanged. - @since 4.03 *) diff --git a/jscomp/stdlib-406/stack.res b/jscomp/stdlib-406/stack.res new file mode 100644 index 0000000000..ee13834b0f --- /dev/null +++ b/jscomp/stdlib-406/stack.res @@ -0,0 +1,55 @@ +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +type t<'a> = {mutable c: list<'a>, mutable len: int} + +exception Empty + +let create = () => {c: list{}, len: 0} + +let clear = s => { + s.c = list{} + s.len = 0 +} + +let copy = s => {c: s.c, len: s.len} + +let push = (x, s) => { + s.c = list{x, ...s.c} + s.len = s.len + 1 +} + +let pop = s => + switch s.c { + | list{hd, ...tl} => + s.c = tl + s.len = s.len - 1 + hd + | list{} => raise(Empty) + } + +let top = s => + switch s.c { + | list{hd, ..._} => hd + | list{} => raise(Empty) + } + +let is_empty = s => s.c == list{} + +let length = s => s.len + +let iter = (f, s) => List.iter(f, s.c) + +let fold = (f, acc, s) => List.fold_left(f, acc, s.c) diff --git a/jscomp/stdlib-406/stack.resi b/jscomp/stdlib-406/stack.resi new file mode 100644 index 0000000000..551d05d3c9 --- /dev/null +++ b/jscomp/stdlib-406/stack.resi @@ -0,0 +1,62 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Last-in first-out stacks. + + This module implements stacks (LIFOs), with in-place modification. +") + +@ocaml.doc(" The type of stacks containing elements of type ['a]. ") +type t<'a> + +@ocaml.doc(" Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. ") +exception Empty + +@ocaml.doc(" Return a new stack, initially empty. ") +let create: unit => t<'a> + +@ocaml.doc(" [push x s] adds the element [x] at the top of stack [s]. ") +let push: ('a, t<'a>) => unit + +@ocaml.doc(" [pop s] removes and returns the topmost element in stack [s], + or raises {!Empty} if the stack is empty. ") +let pop: t<'a> => 'a + +@ocaml.doc(" [top s] returns the topmost element in stack [s], + or raises {!Empty} if the stack is empty. ") +let top: t<'a> => 'a + +@ocaml.doc(" Discard all elements from a stack. ") +let clear: t<'a> => unit + +@ocaml.doc(" Return a copy of the given stack. ") +let copy: t<'a> => t<'a> + +@ocaml.doc(" Return [true] if the given stack is empty, [false] otherwise. ") +let is_empty: t<'a> => bool + +@ocaml.doc(" Return the number of elements in a stack. Time complexity O(1) ") +let length: t<'a> => int + +@ocaml.doc(" [iter f s] applies [f] in turn to all elements of [s], + from the element at the top of the stack to the element at the + bottom of the stack. The stack itself is unchanged. ") +let iter: ('a => unit, t<'a>) => unit + +@ocaml.doc(" [fold f accu s] is [(f (... (f (f accu x1) x2) ...) xn)] + where [x1] is the top of the stack, [x2] the second element, + and [xn] the bottom element. The stack is unchanged. + @since 4.03 ") +let fold: (('b, 'a) => 'b, 'b, t<'a>) => 'b diff --git a/jscomp/stdlib-406/stdLabels.ml b/jscomp/stdlib-406/stdLabels.ml deleted file mode 100644 index 664472b180..0000000000 --- a/jscomp/stdlib-406/stdLabels.ml +++ /dev/null @@ -1,24 +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 [StdLabels]: meta-module for labelled libraries *) - -module Array = ArrayLabels - -module List = ListLabels - -module String = StringLabels - -module Bytes = BytesLabels diff --git a/jscomp/stdlib-406/stdLabels.mli b/jscomp/stdlib-406/stdLabels.mli deleted file mode 100644 index 4b24fd2b5f..0000000000 --- a/jscomp/stdlib-406/stdLabels.mli +++ /dev/null @@ -1,29 +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. *) -(* *) -(**************************************************************************) - -(** Standard labeled libraries. - - This meta-module provides labelized version of the {!Array}, - {!Bytes}, {!List} and {!String} modules. - - They only differ by their labels. Detailed interfaces can be found - in [arrayLabels.mli], [bytesLabels.mli], [listLabels.mli] - and [stringLabels.mli]. -*) - -module Array = ArrayLabels -module Bytes = BytesLabels -module List = ListLabels -module String = StringLabels diff --git a/jscomp/stdlib-406/stdLabels.res b/jscomp/stdlib-406/stdLabels.res new file mode 100644 index 0000000000..8e35db9f80 --- /dev/null +++ b/jscomp/stdlib-406/stdLabels.res @@ -0,0 +1,24 @@ +/* ************************************************************************ */ +/* */ +/* 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 [StdLabels]: meta-module for labelled libraries */ + +module Array = ArrayLabels + +module List = ListLabels + +module String = StringLabels + +module Bytes = BytesLabels diff --git a/jscomp/stdlib-406/stdLabels.resi b/jscomp/stdlib-406/stdLabels.resi new file mode 100644 index 0000000000..9a377b8bcf --- /dev/null +++ b/jscomp/stdlib-406/stdLabels.resi @@ -0,0 +1,29 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" Standard labeled libraries. + + This meta-module provides labelized version of the {!Array}, + {!Bytes}, {!List} and {!String} modules. + + They only differ by their labels. Detailed interfaces can be found + in [arrayLabels.mli], [bytesLabels.mli], [listLabels.mli] + and [stringLabels.mli]. +") + +module Array = ArrayLabels +module Bytes = BytesLabels +module List = ListLabels +module String = StringLabels diff --git a/jscomp/stdlib-406/stream.ml b/jscomp/stdlib-406/stream.ml deleted file mode 100644 index 4e7d27d8fe..0000000000 --- a/jscomp/stdlib-406/stream.ml +++ /dev/null @@ -1,213 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -type 'a t = 'a cell option -and 'a cell = { mutable count : int; mutable data : 'a data } -and 'a data = - Sempty - | Scons of 'a * 'a data - | Sapp of 'a data * 'a data - | Slazy of 'a data Lazy.t - | Sgen of 'a gen -and 'a gen = { mutable curr : 'a option option; func : int -> 'a option } - -exception Failure -exception Error of string - -let count = function - | None -> 0 - | Some { count } -> count -let data = function - | None -> Sempty - | Some { data } -> data - - - -let rec get_data : type v. int -> v data -> v data = fun count d -> match d with - (* Returns either Sempty or Scons(a, _) even when d is a generator - or a buffer. In those cases, the item a is seen as extracted from - the generator/buffer. - The count parameter is used for calling `Sgen-functions'. *) - Sempty | Scons (_, _) -> d - | Sapp (d1, d2) -> - begin match get_data count d1 with - Scons (a, d11) -> Scons (a, Sapp (d11, d2)) - | Sempty -> get_data count d2 - | _ -> assert false - end - | Sgen {curr = Some None} -> Sempty - | Sgen ({curr = Some(Some a)} as g) -> - g.curr <- None; Scons(a, d) - | Sgen g -> - begin match g.func count with - None -> g.curr <- Some(None); Sempty - | Some a -> Scons(a, d) - (* Warning: anyone using g thinks that an item has been read *) - end - | Slazy f -> get_data count (Lazy.force f) - - -let rec peek_data : type v. v cell -> v option = fun s -> - (* consult the first item of s *) - match s.data with - Sempty -> None - | Scons (a, _) -> Some a - | Sapp (_, _) -> - begin match get_data s.count s.data with - Scons(a, _) as d -> s.data <- d; Some a - | Sempty -> None - | _ -> assert false - end - | Slazy f -> s.data <- (Lazy.force f); peek_data s - | Sgen {curr = Some a} -> a - | Sgen g -> let x = g.func s.count in g.curr <- Some x; x - - -let peek = function - | None -> None - | Some s -> peek_data s - - -let rec junk_data : type v. v cell -> unit = fun s -> - match s.data with - Scons (_, d) -> s.count <- (succ s.count); s.data <- d - | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None - | _ -> - match peek_data s with - None -> () - | Some _ -> junk_data s - - -let junk = function - | None -> () - | Some data -> junk_data data - -let rec nget_data n s = - if n <= 0 then [], s.data, 0 - else - match peek_data s with - Some a -> - junk_data s; - let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k - | None -> [], s.data, 0 - - -let npeek_data n s = - let (al, d, len) = nget_data n s in - s.count <- (s.count - len); - s.data <- d; - al - - -let npeek n = function - | None -> [] - | Some d -> npeek_data n d - -let next s = - match peek s with - Some a -> junk s; a - | None -> raise Failure - - -let empty s = - match peek s with - Some _ -> raise Failure - | None -> () - - -let iter f strm = - let rec do_rec () = - match peek strm with - Some a -> junk strm; ignore(f a); do_rec () - | None -> () - in - do_rec () - - -(* Stream building functions *) - -let from f = Some {count = 0; data = Sgen {curr = None; func = f}} - -let of_list l = - Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty} - - -let of_string s = - let count = ref 0 in - from (fun _ -> - (* We cannot use the index passed by the [from] function directly - because it returns the current stream count, with absolutely no - guarantee that it will start from 0. For example, in the case - of [Stream.icons 'c' (Stream.from_string "ab")], the first - access to the string will be made with count [1] already. - *) - let c = !count in - if c < String.length s - then (incr count; Some s.[c]) - else None) - - -let of_bytes s = - let count = ref 0 in - from (fun _ -> - let c = !count in - if c < Bytes.length s - then (incr count; Some (Bytes.get s c)) - else None) - - - - -(* Stream expressions builders *) - -let iapp i s = Some {count = 0; data = Sapp (data i, data s)} -let icons i s = Some {count = 0; data = Scons (i, data s)} -let ising i = Some {count = 0; data = Scons (i, Sempty)} - -let lapp f s = - Some {count = 0; data = Slazy (lazy(Sapp (data (f ()), data s)))} - -let lcons f s = Some {count = 0; data = Slazy (lazy(Scons (f (), data s)))} -let lsing f = Some {count = 0; data = Slazy (lazy(Scons (f (), Sempty)))} - -let sempty = None -let slazy f = Some {count = 0; data = Slazy (lazy(data (f ())))} - -(* For debugging use *) - -let rec dump : type v. (v -> unit) -> v t -> unit = fun f s -> - print_string "{count = "; - print_int (count s); - print_string "; data = "; - dump_data f (data s); - print_string "}"; - print_newline () -and dump_data : type v. (v -> unit) -> v data -> unit = fun f -> - function - Sempty -> print_string "Sempty" - | Scons (a, d) -> - print_string "Scons ("; - f a; - print_string ", "; - dump_data f d; - print_string ")" - | Sapp (d1, d2) -> - print_string "Sapp ("; - dump_data f d1; - print_string ", "; - dump_data f d2; - print_string ")" - | Slazy _ -> print_string "Slazy" - | Sgen _ -> print_string "Sgen" diff --git a/jscomp/stdlib-406/stream.mli b/jscomp/stdlib-406/stream.mli deleted file mode 100644 index 5f8b1868ec..0000000000 --- a/jscomp/stdlib-406/stream.mli +++ /dev/null @@ -1,108 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1997 Institut National de Recherche en Informatique et *) -(* en Automatique. *) -(* *) -(* All rights reserved. This file is distributed under the terms of *) -(* the GNU Lesser General Public License version 2.1, with the *) -(* special exception on linking described in the file LICENSE. *) -(* *) -(**************************************************************************) - -(** Streams and parsers. *) - -type 'a t -(** The type of streams holding values of type ['a]. *) - -exception Failure -(** Raised by parsers when none of the first components of the stream - patterns is accepted. *) - -exception Error of string -(** Raised by parsers when the first component of a stream pattern is - accepted, but one of the following components is rejected. *) - - -(** {1 Stream builders} *) - -val from : (int -> 'a option) -> 'a t -(** [Stream.from f] returns a stream built from the function [f]. - To create a new stream element, the function [f] is called with - the current stream count. The user function [f] must return either - [Some ] for a value or [None] to specify the end of the - stream. - - Do note that the indices passed to [f] may not start at [0] in the - general case. For example, [[< '0; '1; Stream.from f >]] would call - [f] the first time with count [2]. -*) - -val of_list : 'a list -> 'a t -(** Return the stream holding the elements of the list in the same - order. *) - -val of_string : string -> char t -(** Return the stream of the characters of the string parameter. *) - -val of_bytes : bytes -> char t -(** Return the stream of the characters of the bytes parameter. - @since 4.02.0 *) - - - -(** {1 Stream iterator} *) - -val iter : ('a -> unit) -> 'a t -> unit -(** [Stream.iter f s] scans the whole stream s, applying function [f] - in turn to each stream element encountered. *) - - -(** {1 Predefined parsers} *) - -val next : 'a t -> 'a -(** Return the first element of the stream and remove it from the - stream. Raise {!Stream.Failure} if the stream is empty. *) - -val empty : 'a t -> unit -(** Return [()] if the stream is empty, else raise {!Stream.Failure}. *) - - -(** {1 Useful functions} *) - -val peek : 'a t -> 'a option -(** Return [Some] of "the first element" of the stream, or [None] if - the stream is empty. *) - -val junk : 'a t -> unit -(** Remove the first element of the stream, possibly unfreezing - it before. *) - -val count : 'a t -> int -(** Return the current count of the stream elements, i.e. the number - of the stream elements discarded. *) - -val npeek : int -> 'a t -> 'a list -(** [npeek n] returns the list of the [n] first elements of - the stream, or all its remaining elements if less than [n] - elements are available. *) - -(**/**) - -(* The following is for system use only. Do not call directly. *) - -val iapp : 'a t -> 'a t -> 'a t -val icons : 'a -> 'a t -> 'a t -val ising : 'a -> 'a t - -val lapp : (unit -> 'a t) -> 'a t -> 'a t -val lcons : (unit -> 'a) -> 'a t -> 'a t -val lsing : (unit -> 'a) -> 'a t - -val sempty : 'a t -val slazy : (unit -> 'a t) -> 'a t - -val dump : ('a -> unit) -> 'a t -> unit diff --git a/jscomp/stdlib-406/stream.res b/jscomp/stdlib-406/stream.res new file mode 100644 index 0000000000..d819559b63 --- /dev/null +++ b/jscomp/stdlib-406/stream.res @@ -0,0 +1,260 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +type rec t<'a> = option> +and cell<'a> = {mutable count: int, mutable data: data<'a>} +and data<'a> = + | Sempty + | Scons('a, data<'a>) + | Sapp(data<'a>, data<'a>) + | Slazy(Lazy.t>) + | Sgen(gen<'a>) +and gen<'a> = {mutable curr: option>, func: int => option<'a>} + +exception Failure +exception Error(string) + +let count = param => + switch param { + | None => 0 + | Some({count}) => count + } +let data = param => + switch param { + | None => Sempty + | Some({data}) => data + } + +let rec get_data: + type v. (int, data) => data = + (count, d) => + switch d { + /* Returns either Sempty or Scons(a, _) even when d is a generator + or a buffer. In those cases, the item a is seen as extracted from + the generator/buffer. + The count parameter is used for calling `Sgen-functions'. */ + | Sempty | Scons(_, _) => d + | Sapp(d1, d2) => + switch get_data(count, d1) { + | Scons(a, d11) => Scons(a, Sapp(d11, d2)) + | Sempty => get_data(count, d2) + | _ => assert(false) + } + | Sgen({curr: Some(None)}) => Sempty + | Sgen({curr: Some(Some(a))} as g) => + g.curr = None + Scons(a, d) + | Sgen(g) => + switch g.func(count) { + | None => + g.curr = Some(None) + Sempty + | Some(a) => Scons(a, d) + /* Warning: anyone using g thinks that an item has been read */ + } + | Slazy(f) => get_data(count, Lazy.force(f)) + } + +let rec peek_data: + type v. cell => option = + s => + /* consult the first item of s */ + switch s.data { + | Sempty => None + | Scons(a, _) => Some(a) + | Sapp(_, _) => + switch get_data(s.count, s.data) { + | Scons(a, _) as d => + s.data = d + Some(a) + | Sempty => None + | _ => assert(false) + } + | Slazy(f) => + s.data = Lazy.force(f) + peek_data(s) + | Sgen({curr: Some(a)}) => a + | Sgen(g) => + let x = g.func(s.count) + g.curr = Some(x) + x + } + +let peek = param => + switch param { + | None => None + | Some(s) => peek_data(s) + } + +let rec junk_data: + type v. cell => unit = + s => + switch s.data { + | Scons(_, d) => + s.count = succ(s.count) + s.data = d + | Sgen({curr: Some(_)} as g) => + s.count = succ(s.count) + g.curr = None + | _ => + switch peek_data(s) { + | None => () + | Some(_) => junk_data(s) + } + } + +let junk = param => + switch param { + | None => () + | Some(data) => junk_data(data) + } + +let rec nget_data = (n, s) => + if n <= 0 { + (list{}, s.data, 0) + } else { + switch peek_data(s) { + | Some(a) => + junk_data(s) + let (al, d, k) = nget_data(pred(n), s) + (list{a, ...al}, Scons(a, d), succ(k)) + | None => (list{}, s.data, 0) + } + } + +let npeek_data = (n, s) => { + let (al, d, len) = nget_data(n, s) + s.count = s.count - len + s.data = d + al +} + +let npeek = (n, param) => + switch param { + | None => list{} + | Some(d) => npeek_data(n, d) + } + +let next = s => + switch peek(s) { + | Some(a) => + junk(s) + a + | None => raise(Failure) + } + +let empty = s => + switch peek(s) { + | Some(_) => raise(Failure) + | None => () + } + +let iter = (f, strm) => { + let rec do_rec = () => + switch peek(strm) { + | Some(a) => + junk(strm) + ignore(f(a)) + do_rec() + | None => () + } + + do_rec() +} + +/* Stream building functions */ + +let from = f => Some({count: 0, data: Sgen({curr: None, func: f})}) + +let of_list = l => Some({count: 0, data: List.fold_right((x, l) => Scons(x, l), l, Sempty)}) + +let of_string = s => { + let count = ref(0) + from(_ => { + /* We cannot use the index passed by the [from] function directly + because it returns the current stream count, with absolutely no + guarantee that it will start from 0. For example, in the case + of [Stream.icons 'c' (Stream.from_string "ab")], the first + access to the string will be made with count [1] already. + */ + let c = count.contents + if c < String.length(s) { + incr(count) + Some(String.get(s, c)) + } else { + None + } + }) +} + +let of_bytes = s => { + let count = ref(0) + from(_ => { + let c = count.contents + if c < Bytes.length(s) { + incr(count) + Some(Bytes.get(s, c)) + } else { + None + } + }) +} + +/* Stream expressions builders */ + +let iapp = (i, s) => Some({count: 0, data: Sapp(data(i), data(s))}) +let icons = (i, s) => Some({count: 0, data: Scons(i, data(s))}) +let ising = i => Some({count: 0, data: Scons(i, Sempty)}) + +let lapp = (f, s) => Some({count: 0, data: Slazy(lazy Sapp(data(f()), data(s)))}) + +let lcons = (f, s) => Some({count: 0, data: Slazy(lazy Scons(f(), data(s)))}) +let lsing = f => Some({count: 0, data: Slazy(lazy Scons(f(), Sempty))}) + +let sempty = None +let slazy = f => Some({count: 0, data: Slazy(lazy data(f()))}) + +/* For debugging use */ + +let rec dump: + type v. (v => unit, t) => unit = + (f, s) => { + print_string("{count = ") + print_int(count(s)) + print_string("; data = ") + dump_data(f, data(s)) + print_string("}") + print_newline() + } +and dump_data: + type v. (v => unit, data) => unit = + (f, param) => + switch param { + | Sempty => print_string("Sempty") + | Scons(a, d) => + print_string("Scons (") + f(a) + print_string(", ") + dump_data(f, d) + print_string(")") + | Sapp(d1, d2) => + print_string("Sapp (") + dump_data(f, d1) + print_string(", ") + dump_data(f, d2) + print_string(")") + | Slazy(_) => print_string("Slazy") + | Sgen(_) => print_string("Sgen") + } diff --git a/jscomp/stdlib-406/stream.resi b/jscomp/stdlib-406/stream.resi new file mode 100644 index 0000000000..bd554a84c1 --- /dev/null +++ b/jscomp/stdlib-406/stream.resi @@ -0,0 +1,105 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* OCaml */ + /* */ + /* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt */ + /* */ + /* Copyright 1997 Institut National de Recherche en Informatique et */ + /* en Automatique. */ + /* */ + /* All rights reserved. This file is distributed under the terms of */ + /* the GNU Lesser General Public License version 2.1, with the */ + /* special exception on linking described in the file LICENSE. */ + /* */ + /* ************************************************************************ */ + + " Streams and parsers. " +) + +@ocaml.doc(" The type of streams holding values of type ['a]. ") +type t<'a> + +@ocaml.doc(" Raised by parsers when none of the first components of the stream + patterns is accepted. ") +exception Failure + +@ocaml.doc(" Raised by parsers when the first component of a stream pattern is + accepted, but one of the following components is rejected. ") +exception Error(string) + +@@ocaml.text(" {1 Stream builders} ") + +@ocaml.doc(" [Stream.from f] returns a stream built from the function [f]. + To create a new stream element, the function [f] is called with + the current stream count. The user function [f] must return either + [Some ] for a value or [None] to specify the end of the + stream. + + Do note that the indices passed to [f] may not start at [0] in the + general case. For example, [[< '0; '1; Stream.from f >]] would call + [f] the first time with count [2]. +") +let from: (int => option<'a>) => t<'a> + +@ocaml.doc(" Return the stream holding the elements of the list in the same + order. ") +let of_list: list<'a> => t<'a> + +@ocaml.doc(" Return the stream of the characters of the string parameter. ") +let of_string: string => t + +@ocaml.doc(" Return the stream of the characters of the bytes parameter. + @since 4.02.0 ") +let of_bytes: bytes => t + +@@ocaml.text(" {1 Stream iterator} ") + +@ocaml.doc(" [Stream.iter f s] scans the whole stream s, applying function [f] + in turn to each stream element encountered. ") +let iter: ('a => unit, t<'a>) => unit + +@@ocaml.text(" {1 Predefined parsers} ") + +@ocaml.doc(" Return the first element of the stream and remove it from the + stream. Raise {!Stream.Failure} if the stream is empty. ") +let next: t<'a> => 'a + +@ocaml.doc(" Return [()] if the stream is empty, else raise {!Stream.Failure}. ") +let empty: t<'a> => unit + +@@ocaml.text(" {1 Useful functions} ") + +@ocaml.doc(" Return [Some] of \"the first element\" of the stream, or [None] if + the stream is empty. ") +let peek: t<'a> => option<'a> + +@ocaml.doc(" Remove the first element of the stream, possibly unfreezing + it before. ") +let junk: t<'a> => unit + +@ocaml.doc(" Return the current count of the stream elements, i.e. the number + of the stream elements discarded. ") +let count: t<'a> => int + +@ocaml.doc(" [npeek n] returns the list of the [n] first elements of + the stream, or all its remaining elements if less than [n] + elements are available. ") +let npeek: (int, t<'a>) => list<'a> + +@@ocaml.text("/*") + +/* The following is for system use only. Do not call directly. */ + +let iapp: (t<'a>, t<'a>) => t<'a> +let icons: ('a, t<'a>) => t<'a> +let ising: 'a => t<'a> + +let lapp: (unit => t<'a>, t<'a>) => t<'a> +let lcons: (unit => 'a, t<'a>) => t<'a> +let lsing: (unit => 'a) => t<'a> + +let sempty: t<'a> +let slazy: (unit => t<'a>) => t<'a> + +let dump: ('a => unit, t<'a>) => unit diff --git a/jscomp/stdlib-406/string.ml b/jscomp/stdlib-406/string.ml deleted file mode 100644 index a64fb5b8ba..0000000000 --- a/jscomp/stdlib-406/string.ml +++ /dev/null @@ -1,190 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2014 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. *) -(* *) -(**************************************************************************) - -(* String operations, based on byte sequence operations *) - -(* WARNING: Some functions in this file are duplicated in bytes.ml for - efficiency reasons. When you modify the one in this file you need to - modify its duplicate in bytes.ml. - These functions have a "duplicated" comment above their definition. -*) - -external length : string -> int = "%string_length" -external get : string -> int -> char = "%string_safe_get" -external unsafe_get : string -> int -> char = "%string_unsafe_get" - -module B = Bytes - -let bts = B.unsafe_to_string -let bos = B.unsafe_of_string - -external make : int -> char -> string = "?string_repeat" - -let init n f = - B.init n f |> bts -let sub s ofs len = - B.sub (bos s) ofs len |> bts -let blit = - B.blit_string - - - -external%private join : string array -> string -> string = "join" [@@send] - -let concat (sep : string) (xs : string list) = - xs |. Belt_List.toArray |. join sep - -(* duplicated in bytes.ml *) -let iter f s = - for i = 0 to length s - 1 do f (unsafe_get s i) done - -(* duplicated in bytes.ml *) -let iteri f s = - for i = 0 to length s - 1 do f i (unsafe_get s i) done - -let map f s = - B.map f (bos s) |> bts -let mapi f s = - B.mapi f (bos s) |> bts - -(* Beware: we cannot use B.trim or B.escape because they always make a - copy, but String.mli spells out some cases where we are not allowed - to make a copy. *) - -let is_space = function - | ' ' | '\012' | '\n' | '\r' | '\t' -> true - | _ -> false - -let trim s = - if s = "" then s - else if is_space (unsafe_get s 0) || is_space (unsafe_get s (length s - 1)) - then bts (B.trim (bos s)) - else s - -let escaped s = - let rec needs_escape i = - if i >= length s then false else - match unsafe_get s i with - | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true - | ' ' .. '~' -> needs_escape (i+1) - | _ -> true - in - if needs_escape 0 then - bts (B.escaped (bos s)) - else - s - -(* duplicated in bytes.ml *) -let rec index_rec s lim i c = - if i >= lim then raise Not_found else - if unsafe_get s i = c then i else index_rec s lim (i + 1) c - -(* duplicated in bytes.ml *) -let index s c = index_rec s (length s) 0 c - -(* duplicated in bytes.ml *) -let rec index_rec_opt s lim i c = - if i >= lim then None else - if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c - -(* duplicated in bytes.ml *) -let index_opt s c = index_rec_opt s (length s) 0 c - -(* duplicated in bytes.ml *) -let index_from s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else - index_rec s l i c - -(* duplicated in bytes.ml *) -let index_from_opt s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else - index_rec_opt s l i c - -(* duplicated in bytes.ml *) -let rec rindex_rec s i c = - if i < 0 then raise Not_found else - if unsafe_get s i = c then i else rindex_rec s (i - 1) c - -(* duplicated in bytes.ml *) -let rindex s c = rindex_rec s (length s - 1) c - -(* duplicated in bytes.ml *) -let rindex_from s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from / Bytes.rindex_from" - else - rindex_rec s i c - -(* duplicated in bytes.ml *) -let rec rindex_rec_opt s i c = - if i < 0 then None else - if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c - -(* duplicated in bytes.ml *) -let rindex_opt s c = rindex_rec_opt s (length s - 1) c - -(* duplicated in bytes.ml *) -let rindex_from_opt s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt" - else - rindex_rec_opt s i c - -(* duplicated in bytes.ml *) -let contains_from s i c = - let l = length s in - if i < 0 || i > l then - invalid_arg "String.contains_from / Bytes.contains_from" - else - try ignore (index_rec s l i c); true with Not_found -> false - -(* duplicated in bytes.ml *) -let contains s c = contains_from s 0 c - -(* duplicated in bytes.ml *) -let rcontains_from s i c = - if i < 0 || i >= length s then - invalid_arg "String.rcontains_from / Bytes.rcontains_from" - else - try ignore (rindex_rec s i c); true with Not_found -> false - -let uppercase_ascii s = - B.uppercase_ascii (bos s) |> bts -let lowercase_ascii s = - B.lowercase_ascii (bos s) |> bts -let capitalize_ascii s = - B.capitalize_ascii (bos s) |> bts -let uncapitalize_ascii s = - B.uncapitalize_ascii (bos s) |> bts - -type t = string - -let compare (x: t) (y: t) = Pervasives.compare x y -let equal : string -> string -> bool = fun a b -> a = b - -let split_on_char sep s = - let r = ref [] in - let j = ref (length s) in - for i = length s - 1 downto 0 do - if unsafe_get s i = sep then begin - r := sub s (i + 1) (!j - i - 1) :: !r; - j := i - end - done; - sub s 0 !j :: !r - - diff --git a/jscomp/stdlib-406/string.res b/jscomp/stdlib-406/string.res new file mode 100644 index 0000000000..ba88a522e6 --- /dev/null +++ b/jscomp/stdlib-406/string.res @@ -0,0 +1,235 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2014 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. */ +/* */ +/* ************************************************************************ */ + +/* String operations, based on byte sequence operations */ + +/* WARNING: Some functions in this file are duplicated in bytes.ml for + efficiency reasons. When you modify the one in this file you need to + modify its duplicate in bytes.ml. + These functions have a "duplicated" comment above their definition. +*/ + +external length: string => int = "%string_length" +external get: (string, int) => char = "%string_safe_get" +external unsafe_get: (string, int) => char = "%string_unsafe_get" + +module B = Bytes + +let bts = B.unsafe_to_string +let bos = B.unsafe_of_string + +external make: (int, char) => string = "?string_repeat" + +let init = (n, f) => B.init(n, f) |> bts +let sub = (s, ofs, len) => B.sub(bos(s), ofs, len) |> bts +let blit = B.blit_string + +%%private(@send external join: (array, string) => string = "join") + +let concat = (sep: string, xs: list) => xs->Belt_List.toArray->join(sep) + +/* duplicated in bytes.ml */ +let iter = (f, s) => + for i in 0 to length(s) - 1 { + f(unsafe_get(s, i)) + } + +/* duplicated in bytes.ml */ +let iteri = (f, s) => + for i in 0 to length(s) - 1 { + f(i, unsafe_get(s, i)) + } + +let map = (f, s) => B.map(f, bos(s)) |> bts +let mapi = (f, s) => B.mapi(f, bos(s)) |> bts + +/* Beware: we cannot use B.trim or B.escape because they always make a + copy, but String.mli spells out some cases where we are not allowed + to make a copy. */ + +let is_space = param => + switch param { + | ' ' | ' ' | '\n' | '\r' | '\t' => true + | _ => false + } + +let trim = s => + if s == "" { + s + } else if is_space(unsafe_get(s, 0)) || is_space(unsafe_get(s, length(s) - 1)) { + bts(B.trim(bos(s))) + } else { + s + } + +let escaped = s => { + let rec needs_escape = i => + if i >= length(s) { + false + } else { + switch unsafe_get(s, i) { + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' => true + | ' ' .. '~' => needs_escape(i + 1) + | _ => true + } + } + + if needs_escape(0) { + bts(B.escaped(bos(s))) + } else { + s + } +} + +/* duplicated in bytes.ml */ +let rec index_rec = (s, lim, i, c) => + if i >= lim { + raise(Not_found) + } else if unsafe_get(s, i) == c { + i + } else { + index_rec(s, lim, i + 1, c) + } + +/* duplicated in bytes.ml */ +let index = (s, c) => index_rec(s, length(s), 0, c) + +/* duplicated in bytes.ml */ +let rec index_rec_opt = (s, lim, i, c) => + if i >= lim { + None + } else if unsafe_get(s, i) == c { + Some(i) + } else { + index_rec_opt(s, lim, i + 1, c) + } + +/* duplicated in bytes.ml */ +let index_opt = (s, c) => index_rec_opt(s, length(s), 0, c) + +/* duplicated in bytes.ml */ +let index_from = (s, i, c) => { + let l = length(s) + if i < 0 || i > l { + invalid_arg("String.index_from / Bytes.index_from") + } else { + index_rec(s, l, i, c) + } +} + +/* duplicated in bytes.ml */ +let index_from_opt = (s, i, c) => { + let l = length(s) + if i < 0 || i > l { + invalid_arg("String.index_from_opt / Bytes.index_from_opt") + } else { + index_rec_opt(s, l, i, c) + } +} + +/* duplicated in bytes.ml */ +let rec rindex_rec = (s, i, c) => + if i < 0 { + raise(Not_found) + } else if unsafe_get(s, i) == c { + i + } else { + rindex_rec(s, i - 1, c) + } + +/* duplicated in bytes.ml */ +let rindex = (s, c) => rindex_rec(s, length(s) - 1, c) + +/* duplicated in bytes.ml */ +let rindex_from = (s, i, c) => + if i < -1 || i >= length(s) { + invalid_arg("String.rindex_from / Bytes.rindex_from") + } else { + rindex_rec(s, i, c) + } + +/* duplicated in bytes.ml */ +let rec rindex_rec_opt = (s, i, c) => + if i < 0 { + None + } else if unsafe_get(s, i) == c { + Some(i) + } else { + rindex_rec_opt(s, i - 1, c) + } + +/* duplicated in bytes.ml */ +let rindex_opt = (s, c) => rindex_rec_opt(s, length(s) - 1, c) + +/* duplicated in bytes.ml */ +let rindex_from_opt = (s, i, c) => + if i < -1 || i >= length(s) { + invalid_arg("String.rindex_from_opt / Bytes.rindex_from_opt") + } else { + rindex_rec_opt(s, i, c) + } + +/* duplicated in bytes.ml */ +let contains_from = (s, i, c) => { + let l = length(s) + if i < 0 || i > l { + invalid_arg("String.contains_from / Bytes.contains_from") + } else { + try { + ignore(index_rec(s, l, i, c)) + true + } catch { + | Not_found => false + } + } +} + +/* duplicated in bytes.ml */ +let contains = (s, c) => contains_from(s, 0, c) + +/* duplicated in bytes.ml */ +let rcontains_from = (s, i, c) => + if i < 0 || i >= length(s) { + invalid_arg("String.rcontains_from / Bytes.rcontains_from") + } else { + try { + ignore(rindex_rec(s, i, c)) + true + } catch { + | Not_found => false + } + } + +let uppercase_ascii = s => B.uppercase_ascii(bos(s)) |> bts +let lowercase_ascii = s => B.lowercase_ascii(bos(s)) |> bts +let capitalize_ascii = s => B.capitalize_ascii(bos(s)) |> bts +let uncapitalize_ascii = s => B.uncapitalize_ascii(bos(s)) |> bts + +type t = string + +let compare = (x: t, y: t) => Pervasives.compare(x, y) +let equal: (string, string) => bool = (a, b) => a == b + +let split_on_char = (sep, s) => { + let r = ref(list{}) + let j = ref(length(s)) + for i in length(s) - 1 downto 0 { + if unsafe_get(s, i) == sep { + r := list{sub(s, i + 1, j.contents - i - 1), ...r.contents} + j := i + } + } + list{sub(s, 0, j.contents), ...r.contents} +} diff --git a/jscomp/stdlib-406/string.mli b/jscomp/stdlib-406/string.resi similarity index 52% rename from jscomp/stdlib-406/string.mli rename to jscomp/stdlib-406/string.resi index 391f3196c0..7bbfd0f678 100644 --- a/jscomp/stdlib-406/string.mli +++ b/jscomp/stdlib-406/string.resi @@ -1,19 +1,19 @@ -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -(** String operations. +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" String operations. A string is an immutable data structure that contains a fixed-length sequence of (single-byte) characters. Each character @@ -35,7 +35,7 @@ OCaml strings used to be modifiable in place, for instance via the {!String.set} and {!String.blit} functions described below. This usage is deprecated and only possible when the compiler is put in - "unsafe-string" mode by giving the [-unsafe-string] command-line + \"unsafe-string\" mode by giving the [-unsafe-string] command-line option (which is currently the default for reasons of backward compatibility). This is done by making the types [string] and [bytes] (see module {!Bytes}) interchangeable so that functions @@ -46,90 +46,83 @@ [-safe-string] command-line option to enforce the separation between the types [string] and [bytes]. - *) + ") -external length : string -> int = "%string_length" -(** Return the length (number of characters) of the given string. *) +@ocaml.doc(" Return the length (number of characters) of the given string. ") +external length: string => int = "%string_length" -external get : string -> int -> char = "%string_safe_get" -(** [String.get s n] returns the character at index [n] in string [s]. +@ocaml.doc(" [String.get s n] returns the character at index [n] in string [s]. You can also write [s.[n]] instead of [String.get s n]. - Raise [Invalid_argument] if [n] not a valid index in [s]. *) + Raise [Invalid_argument] if [n] not a valid index in [s]. ") +external get: (string, int) => char = "%string_safe_get" - - - -val make : int -> char -> string -(** [String.make n c] returns a fresh string of length [n], +@ocaml.doc(" [String.make n c] returns a fresh string of length [n], filled with the character [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +let make: (int, char) => string -val init : int -> (int -> char) -> string -(** [String.init n f] returns a string of length [n], with character +@ocaml.doc(" [String.init n f] returns a string of length [n], with character [i] initialized to the result of [f i] (called in increasing index order). Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. @since 4.02.0 -*) - +") +let init: (int, int => char) => string -val sub : string -> int -> int -> string -(** [String.sub s start len] returns a fresh string of length [len], +@ocaml.doc(" [String.sub s start len] returns a fresh string of length [len], containing the substring of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]. *) + designate a valid substring of [s]. ") +let sub: (string, int, int) => string +@ocaml.doc(" Same as {!Bytes.blit_string}. ") +let blit: (string, int, bytes, int, int) => unit - -val blit : string -> int -> bytes -> int -> int -> unit -(** Same as {!Bytes.blit_string}. *) - -val concat : string -> string list -> string -(** [String.concat sep sl] concatenates the list of strings [sl], +@ocaml.doc(" [String.concat sep sl] concatenates the list of strings [sl], inserting the separator string [sep] between each. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. *) + {!Sys.max_string_length} bytes. ") +let concat: (string, list) => string -val iter : (char -> unit) -> string -> unit -(** [String.iter f s] applies function [f] in turn to all +@ocaml.doc(" [String.iter f s] applies function [f] in turn to all the characters of [s]. It is equivalent to - [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *) + [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. ") +let iter: (char => unit, string) => unit -val iteri : (int -> char -> unit) -> string -> unit -(** Same as {!String.iter}, but the +@ocaml.doc(" Same as {!String.iter}, but the function is applied to the index of the element as first argument (counting from 0), and the character itself as second argument. - @since 4.00.0 *) + @since 4.00.0 ") +let iteri: ((int, char) => unit, string) => unit -val map : (char -> char) -> string -> string -(** [String.map f s] applies function [f] in turn to all the +@ocaml.doc(" [String.map f s] applies function [f] in turn to all the characters of [s] (in increasing index order) and stores the results in a new string that is returned. - @since 4.00.0 *) + @since 4.00.0 ") +let map: (char => char, string) => string -val mapi : (int -> char -> char) -> string -> string -(** [String.mapi f s] calls [f] with each character of [s] and its +@ocaml.doc(" [String.mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the results in a new string that is returned. - @since 4.02.0 *) + @since 4.02.0 ") +let mapi: ((int, char) => char, string) => string -val trim : string -> string -(** Return a copy of the argument, without leading and trailing +@ocaml.doc(" Return a copy of the argument, without leading and trailing whitespace. The characters regarded as whitespace are: [' '], ['\012'], ['\n'], ['\r'], and ['\t']. If there is neither leading nor trailing whitespace character in the argument, return the original string itself, not a copy. - @since 4.00.0 *) + @since 4.00.0 ") +let trim: string => string -val escaped : string -> string -(** Return a copy of the argument, with special characters +@ocaml.doc(" Return a copy of the argument, with special characters represented by escape sequences, following the lexical conventions of OCaml. All characters outside the ASCII printable range (32..126) are @@ -143,42 +136,42 @@ val escaped : string -> string The function {!Scanf.unescaped} is a left inverse of [escaped], i.e. [Scanf.unescaped (escaped s) = s] for any string [s] (unless - [escape s] fails). *) + [escape s] fails). ") +let escaped: string => string -val index : string -> char -> int -(** [String.index s c] returns the index of the first +@ocaml.doc(" [String.index s c] returns the index of the first occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. *) + Raise [Not_found] if [c] does not occur in [s]. ") +let index: (string, char) => int -val index_opt: string -> char -> int option -(** [String.index_opt s c] returns the index of the first +@ocaml.doc(" [String.index_opt s c] returns the index of the first occurrence of character [c] in string [s], or [None] if [c] does not occur in [s]. - @since 4.05 *) + @since 4.05 ") +let index_opt: (string, char) => option -val rindex : string -> char -> int -(** [String.rindex s c] returns the index of the last +@ocaml.doc(" [String.rindex s c] returns the index of the last occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. *) + Raise [Not_found] if [c] does not occur in [s]. ") +let rindex: (string, char) => int -val rindex_opt: string -> char -> int option -(** [String.rindex_opt s c] returns the index of the last occurrence +@ocaml.doc(" [String.rindex_opt s c] returns the index of the last occurrence of character [c] in string [s], or [None] if [c] does not occur in [s]. - @since 4.05 *) + @since 4.05 ") +let rindex_opt: (string, char) => option -val index_from : string -> int -> char -> int -(** [String.index_from s i c] returns the index of the +@ocaml.doc(" [String.index_from s i c] returns the index of the first occurrence of character [c] in string [s] after position [i]. [String.index s c] is equivalent to [String.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. *) + Raise [Not_found] if [c] does not occur in [s] after position [i]. ") +let index_from: (string, int, char) => int -val index_from_opt: string -> int -> char -> int option -(** [String.index_from_opt s i c] returns the index of the +@ocaml.doc(" [String.index_from_opt s i c] returns the index of the first occurrence of character [c] in string [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. @@ -186,19 +179,19 @@ val index_from_opt: string -> int -> char -> int option Raise [Invalid_argument] if [i] is not a valid position in [s]. @since 4.05 -*) +") +let index_from_opt: (string, int, char) => option -val rindex_from : string -> int -> char -> int -(** [String.rindex_from s i c] returns the index of the +@ocaml.doc(" [String.rindex_from s i c] returns the index of the last occurrence of character [c] in string [s] before position [i+1]. [String.rindex s c] is equivalent to [String.rindex_from s (String.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") +let rindex_from: (string, int, char) => int -val rindex_from_opt: string -> int -> char -> int option -(** [String.rindex_from_opt s i c] returns the index of the +@ocaml.doc(" [String.rindex_from_opt s i c] returns the index of the last occurrence of character [c] in string [s] before position [i+1] or [None] if [c] does not occur in [s] before position [i+1]. @@ -208,63 +201,62 @@ val rindex_from_opt: string -> int -> char -> int option Raise [Invalid_argument] if [i+1] is not a valid position in [s]. @since 4.05 -*) +") +let rindex_from_opt: (string, int, char) => option -val contains : string -> char -> bool -(** [String.contains s c] tests if character [c] - appears in the string [s]. *) +@ocaml.doc(" [String.contains s c] tests if character [c] + appears in the string [s]. ") +let contains: (string, char) => bool -val contains_from : string -> int -> char -> bool -(** [String.contains_from s start c] tests if character [c] +@ocaml.doc(" [String.contains_from s start c] tests if character [c] appears in [s] after position [start]. [String.contains s c] is equivalent to [String.contains_from s 0 c]. - Raise [Invalid_argument] if [start] is not a valid position in [s]. *) + Raise [Invalid_argument] if [start] is not a valid position in [s]. ") +let contains_from: (string, int, char) => bool -val rcontains_from : string -> int -> char -> bool -(** [String.rcontains_from s stop c] tests if character [c] +@ocaml.doc(" [String.rcontains_from s stop c] tests if character [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. *) + position in [s]. ") +let rcontains_from: (string, int, char) => bool - -val uppercase_ascii : string -> string -(** Return a copy of the argument, with all lowercase letters +@ocaml.doc(" Return a copy of the argument, with all lowercase letters translated to uppercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let uppercase_ascii: string => string -val lowercase_ascii : string -> string -(** Return a copy of the argument, with all uppercase letters +@ocaml.doc(" Return a copy of the argument, with all uppercase letters translated to lowercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let lowercase_ascii: string => string -val capitalize_ascii : string -> string -(** Return a copy of the argument, with the first character set to uppercase, +@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let capitalize_ascii: string => string -val uncapitalize_ascii : string -> string -(** Return a copy of the argument, with the first character set to lowercase, +@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, using the US-ASCII character set. - @since 4.03.0 *) + @since 4.03.0 ") +let uncapitalize_ascii: string => string +@ocaml.doc(" An alias for the type of strings. ") type t = string -(** An alias for the type of strings. *) -val compare: t -> t -> int -(** The comparison function for strings, with the same specification as +@ocaml.doc(" The comparison function for strings, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [String] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) + {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int -val equal: t -> t -> bool -(** The equal function for strings. - @since 4.03.0 *) +@ocaml.doc(" The equal function for strings. + @since 4.03.0 ") +let equal: (t, t) => bool -val split_on_char: char -> string -> string list -(** [String.split_on_char sep s] returns the list of all (possibly empty) +@ocaml.doc(" [String.split_on_char sep s] returns the list of all (possibly empty) substrings of [s] that are delimited by the [sep] character. The function's output is specified by the following invariants: @@ -276,11 +268,11 @@ val split_on_char: char -> string -> string list - No string in the result contains the [sep] character. @since 4.04.0 -*) - -(**/**) +") +let split_on_char: (char, string) => list -(* The following is for system use only. Do not call directly. *) +@@ocaml.text("/*") -external unsafe_get : string -> int -> char = "%string_unsafe_get" +/* The following is for system use only. Do not call directly. */ +external unsafe_get: (string, int) => char = "%string_unsafe_get" diff --git a/jscomp/stdlib-406/stringLabels.ml b/jscomp/stdlib-406/stringLabels.ml deleted file mode 100644 index 3680a6b617..0000000000 --- a/jscomp/stdlib-406/stringLabels.ml +++ /dev/null @@ -1,190 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Damien Doligez, projet Gallium, INRIA Rocquencourt *) -(* *) -(* Copyright 2014 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. *) -(* *) -(**************************************************************************) - -(* String operations, based on byte sequence operations *) - -(* WARNING: Some functions in this file are duplicated in bytes.ml for - efficiency reasons. When you modify the one in this file you need to - modify its duplicate in bytes.ml. - These functions have a "duplicated" comment above their definition. -*) - -external length : string -> int = "%string_length" -external get : string -> int -> char = "%string_safe_get" -external unsafe_get : string -> int -> char = "%string_unsafe_get" - -module B = Bytes - -let bts = B.unsafe_to_string -let bos = B.unsafe_of_string - -external make : int -> char -> string = "?string_repeat" - -let init n ~f = - B.init n f |> bts -let sub s ~pos:ofs ~len = - B.sub (bos s) ofs len |> bts -let blit ~src ~src_pos ~dst ~dst_pos ~len = - B.blit_string src src_pos dst dst_pos len - - - -external%private join : string array -> string -> string = "join" [@@send] - -let concat ~(sep : string) (xs : string list) = - xs |. Belt_List.toArray |. join sep - -(* duplicated in bytes.ml *) -let iter ~f s = - for i = 0 to length s - 1 do f (unsafe_get s i) done - -(* duplicated in bytes.ml *) -let iteri ~f s = - for i = 0 to length s - 1 do f i (unsafe_get s i) done - -let map ~f s = - B.map f (bos s) |> bts -let mapi ~f s = - B.mapi f (bos s) |> bts - -(* Beware: we cannot use B.trim or B.escape because they always make a - copy, but String.mli spells out some cases where we are not allowed - to make a copy. *) - -let is_space = function - | ' ' | '\012' | '\n' | '\r' | '\t' -> true - | _ -> false - -let trim s = - if s = "" then s - else if is_space (unsafe_get s 0) || is_space (unsafe_get s (length s - 1)) - then bts (B.trim (bos s)) - else s - -let escaped s = - let rec needs_escape i = - if i >= length s then false else - match unsafe_get s i with - | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> true - | ' ' .. '~' -> needs_escape (i+1) - | _ -> true - in - if needs_escape 0 then - bts (B.escaped (bos s)) - else - s - -(* duplicated in bytes.ml *) -let rec index_rec s lim i c = - if i >= lim then raise Not_found else - if unsafe_get s i = c then i else index_rec s lim (i + 1) c - -(* duplicated in bytes.ml *) -let index s c = index_rec s (length s) 0 c - -(* duplicated in bytes.ml *) -let rec index_rec_opt s lim i c = - if i >= lim then None else - if unsafe_get s i = c then Some i else index_rec_opt s lim (i + 1) c - -(* duplicated in bytes.ml *) -let index_opt s c = index_rec_opt s (length s) 0 c - -(* duplicated in bytes.ml *) -let index_from s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from / Bytes.index_from" else - index_rec s l i c - -(* duplicated in bytes.ml *) -let index_from_opt s i c = - let l = length s in - if i < 0 || i > l then invalid_arg "String.index_from_opt / Bytes.index_from_opt" else - index_rec_opt s l i c - -(* duplicated in bytes.ml *) -let rec rindex_rec s i c = - if i < 0 then raise Not_found else - if unsafe_get s i = c then i else rindex_rec s (i - 1) c - -(* duplicated in bytes.ml *) -let rindex s c = rindex_rec s (length s - 1) c - -(* duplicated in bytes.ml *) -let rindex_from s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from / Bytes.rindex_from" - else - rindex_rec s i c - -(* duplicated in bytes.ml *) -let rec rindex_rec_opt s i c = - if i < 0 then None else - if unsafe_get s i = c then Some i else rindex_rec_opt s (i - 1) c - -(* duplicated in bytes.ml *) -let rindex_opt s c = rindex_rec_opt s (length s - 1) c - -(* duplicated in bytes.ml *) -let rindex_from_opt s i c = - if i < -1 || i >= length s then - invalid_arg "String.rindex_from_opt / Bytes.rindex_from_opt" - else - rindex_rec_opt s i c - -(* duplicated in bytes.ml *) -let contains_from s i c = - let l = length s in - if i < 0 || i > l then - invalid_arg "String.contains_from / Bytes.contains_from" - else - try ignore (index_rec s l i c); true with Not_found -> false - -(* duplicated in bytes.ml *) -let contains s c = contains_from s 0 c - -(* duplicated in bytes.ml *) -let rcontains_from s i c = - if i < 0 || i >= length s then - invalid_arg "String.rcontains_from / Bytes.rcontains_from" - else - try ignore (rindex_rec s i c); true with Not_found -> false - -let uppercase_ascii s = - B.uppercase_ascii (bos s) |> bts -let lowercase_ascii s = - B.lowercase_ascii (bos s) |> bts -let capitalize_ascii s = - B.capitalize_ascii (bos s) |> bts -let uncapitalize_ascii s = - B.uncapitalize_ascii (bos s) |> bts - -type t = string - -let compare (x: t) (y: t) = Pervasives.compare x y -let equal : string -> string -> bool = fun a b -> a = b - -let split_on_char ~sep s = - let r = ref [] in - let j = ref (length s) in - for i = length s - 1 downto 0 do - if unsafe_get s i = sep then begin - r := sub s ~pos:(i + 1) ~len:(!j - i - 1) :: !r; - j := i - end - done; - sub s ~pos:0 ~len:!j :: !r - - diff --git a/jscomp/stdlib-406/stringLabels.mli b/jscomp/stdlib-406/stringLabels.mli deleted file mode 100644 index 20373e046d..0000000000 --- a/jscomp/stdlib-406/stringLabels.mli +++ /dev/null @@ -1,241 +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. *) -(* *) -(**************************************************************************) - -(** String operations. *) - -external length : string -> int = "%string_length" -(** Return the length (number of characters) of the given string. *) - -external get : string -> int -> char = "%string_safe_get" -(** [String.get s n] returns the character at index [n] in string [s]. - You can also write [s.[n]] instead of [String.get s n]. - - Raise [Invalid_argument] if [n] not a valid index in [s]. *) - - -val make : int -> char -> string -(** [String.make n c] returns a fresh string of length [n], - filled with the character [c]. - - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. *) - -val init : int -> f:(int -> char) -> string -(** [init n f] returns a string of length [n], - with character [i] initialized to the result of [f i]. - - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. - @since 4.02.0 *) - - -val sub : string -> pos:int -> len:int -> string -(** [String.sub s start len] returns a fresh string of length [len], - containing the substring of [s] that starts at position [start] and - has length [len]. - - Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]. *) - - -val blit : - src:string -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int - -> unit -(** [String.blit src srcoff dst dstoff len] copies [len] bytes - from the string [src], starting at index [srcoff], - to byte sequence [dst], starting at character number [dstoff]. - - Raise [Invalid_argument] if [srcoff] and [len] do not - designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. *) - -val concat : sep:string -> string list -> string -(** [String.concat sep sl] concatenates the list of strings [sl], - inserting the separator string [sep] between each. *) - -val iter : f:(char -> unit) -> string -> unit -(** [String.iter f s] applies function [f] in turn to all - the characters of [s]. It is equivalent to - [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. *) - -val iteri : f:(int -> char -> unit) -> string -> unit -(** Same as {!String.iter}, but the - function is applied to the index of the element as first argument - (counting from 0), and the character itself as second argument. - @since 4.00.0 *) - -val map : f:(char -> char) -> string -> string -(** [String.map f s] applies function [f] in turn to all - the characters of [s] and stores the results in a new string that - is returned. - @since 4.00.0 *) - -val mapi : f:(int -> char -> char) -> string -> string -(** [String.mapi f s] calls [f] with each character of [s] and its - index (in increasing index order) and stores the results in a new - string that is returned. - @since 4.02.0 *) - -val trim : string -> string -(** Return a copy of the argument, without leading and trailing - whitespace. The characters regarded as whitespace are: [' '], - ['\012'], ['\n'], ['\r'], and ['\t']. If there is no leading nor - trailing whitespace character in the argument, return the original - string itself, not a copy. - @since 4.00.0 *) - -val escaped : string -> string -(** Return a copy of the argument, with special characters - represented by escape sequences, following the lexical - conventions of OCaml. If there is no special - character in the argument, return the original string itself, - not a copy. Its inverse function is Scanf.unescaped. *) - -val index : string -> char -> int -(** [String.index s c] returns the index of the first - occurrence of character [c] in string [s]. - - Raise [Not_found] if [c] does not occur in [s]. *) - -val index_opt: string -> char -> int option -(** [String.index_opt s c] returns the index of the first - occurrence of character [c] in string [s], or - [None] if [c] does not occur in [s]. - @since 4.05 *) - -val rindex : string -> char -> int -(** [String.rindex s c] returns the index of the last - occurrence of character [c] in string [s]. - - Raise [Not_found] if [c] does not occur in [s]. *) - -val rindex_opt: string -> char -> int option -(** [String.rindex_opt s c] returns the index of the last occurrence - of character [c] in string [s], or [None] if [c] does not occur in - [s]. - @since 4.05 *) - -val index_from : string -> int -> char -> int -(** [String.index_from s i c] returns the index of the - first occurrence of character [c] in string [s] after position [i]. - [String.index s c] is equivalent to [String.index_from s 0 c]. - - Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. *) - -val index_from_opt: string -> int -> char -> int option -(** [String.index_from_opt s i c] returns the index of the - first occurrence of character [c] in string [s] after position [i] - or [None] if [c] does not occur in [s] after position [i]. - - [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c]. - Raise [Invalid_argument] if [i] is not a valid position in [s]. - - @since 4.05 -*) - -val rindex_from : string -> int -> char -> int -(** [String.rindex_from s i c] returns the index of the - last occurrence of character [c] in string [s] before position [i+1]. - [String.rindex s c] is equivalent to - [String.rindex_from s (String.length s - 1) c]. - - Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. *) - -val rindex_from_opt: string -> int -> char -> int option -(** [String.rindex_from_opt s i c] returns the index of the - last occurrence of character [c] in string [s] before position [i+1] - or [None] if [c] does not occur in [s] before position [i+1]. - - [String.rindex_opt s c] is equivalent to - [String.rindex_from_opt s (String.length s - 1) c]. - - Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - - @since 4.05 -*) - -val contains : string -> char -> bool -(** [String.contains s c] tests if character [c] - appears in the string [s]. *) - -val contains_from : string -> int -> char -> bool -(** [String.contains_from s start c] tests if character [c] - appears in [s] after position [start]. - [String.contains s c] is equivalent to - [String.contains_from s 0 c]. - - Raise [Invalid_argument] if [start] is not a valid position in [s]. *) - -val rcontains_from : string -> int -> char -> bool -(** [String.rcontains_from s stop c] tests if character [c] - appears in [s] before position [stop+1]. - - Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. *) - - -val uppercase_ascii : string -> string -(** Return a copy of the argument, with all lowercase letters - translated to uppercase, using the US-ASCII character set. - @since 4.05.0 *) - -val lowercase_ascii : string -> string -(** Return a copy of the argument, with all uppercase letters - translated to lowercase, using the US-ASCII character set. - @since 4.05.0 *) - -val capitalize_ascii : string -> string -(** Return a copy of the argument, with the first character set to uppercase, - using the US-ASCII character set. - @since 4.05.0 *) - -val uncapitalize_ascii : string -> string -(** Return a copy of the argument, with the first character set to lowercase, - using the US-ASCII character set. - @since 4.05.0 *) - -type t = string -(** An alias for the type of strings. *) - -val compare: t -> t -> int -(** The comparison function for strings, with the same specification as - {!Pervasives.compare}. Along with the type [t], this function [compare] - allows the module [String] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. *) - -val equal: t -> t -> bool -(** The equal function for strings. - @since 4.05.0 *) - -val split_on_char: sep:char -> string -> string list -(** [String.split_on_char sep s] returns the list of all (possibly empty) - substrings of [s] that are delimited by the [sep] character. - - The function's output is specified by the following invariants: - - - The list is not empty. - - Concatenating its elements using [sep] as a separator returns a - string equal to the input ([String.concat (String.make 1 sep) - (String.split_on_char sep s) = s]). - - No string in the result contains the [sep] character. - - @since 4.05.0 -*) - -(**/**) - -(* The following is for system use only. Do not call directly. *) - -external unsafe_get : string -> int -> char = "%string_unsafe_get" diff --git a/jscomp/stdlib-406/stringLabels.res b/jscomp/stdlib-406/stringLabels.res new file mode 100644 index 0000000000..6d6511f21f --- /dev/null +++ b/jscomp/stdlib-406/stringLabels.res @@ -0,0 +1,235 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Gallium, INRIA Rocquencourt */ +/* */ +/* Copyright 2014 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. */ +/* */ +/* ************************************************************************ */ + +/* String operations, based on byte sequence operations */ + +/* WARNING: Some functions in this file are duplicated in bytes.ml for + efficiency reasons. When you modify the one in this file you need to + modify its duplicate in bytes.ml. + These functions have a "duplicated" comment above their definition. +*/ + +external length: string => int = "%string_length" +external get: (string, int) => char = "%string_safe_get" +external unsafe_get: (string, int) => char = "%string_unsafe_get" + +module B = Bytes + +let bts = B.unsafe_to_string +let bos = B.unsafe_of_string + +external make: (int, char) => string = "?string_repeat" + +let init = (n, ~f) => B.init(n, f) |> bts +let sub = (s, ~pos as ofs, ~len) => B.sub(bos(s), ofs, len) |> bts +let blit = (~src, ~src_pos, ~dst, ~dst_pos, ~len) => B.blit_string(src, src_pos, dst, dst_pos, len) + +%%private(@send external join: (array, string) => string = "join") + +let concat = (~sep: string, xs: list) => xs->Belt_List.toArray->join(sep) + +/* duplicated in bytes.ml */ +let iter = (~f, s) => + for i in 0 to length(s) - 1 { + f(unsafe_get(s, i)) + } + +/* duplicated in bytes.ml */ +let iteri = (~f, s) => + for i in 0 to length(s) - 1 { + f(i, unsafe_get(s, i)) + } + +let map = (~f, s) => B.map(f, bos(s)) |> bts +let mapi = (~f, s) => B.mapi(f, bos(s)) |> bts + +/* Beware: we cannot use B.trim or B.escape because they always make a + copy, but String.mli spells out some cases where we are not allowed + to make a copy. */ + +let is_space = param => + switch param { + | ' ' | ' ' | '\n' | '\r' | '\t' => true + | _ => false + } + +let trim = s => + if s == "" { + s + } else if is_space(unsafe_get(s, 0)) || is_space(unsafe_get(s, length(s) - 1)) { + bts(B.trim(bos(s))) + } else { + s + } + +let escaped = s => { + let rec needs_escape = i => + if i >= length(s) { + false + } else { + switch unsafe_get(s, i) { + | '"' | '\\' | '\n' | '\t' | '\r' | '\b' => true + | ' ' .. '~' => needs_escape(i + 1) + | _ => true + } + } + + if needs_escape(0) { + bts(B.escaped(bos(s))) + } else { + s + } +} + +/* duplicated in bytes.ml */ +let rec index_rec = (s, lim, i, c) => + if i >= lim { + raise(Not_found) + } else if unsafe_get(s, i) == c { + i + } else { + index_rec(s, lim, i + 1, c) + } + +/* duplicated in bytes.ml */ +let index = (s, c) => index_rec(s, length(s), 0, c) + +/* duplicated in bytes.ml */ +let rec index_rec_opt = (s, lim, i, c) => + if i >= lim { + None + } else if unsafe_get(s, i) == c { + Some(i) + } else { + index_rec_opt(s, lim, i + 1, c) + } + +/* duplicated in bytes.ml */ +let index_opt = (s, c) => index_rec_opt(s, length(s), 0, c) + +/* duplicated in bytes.ml */ +let index_from = (s, i, c) => { + let l = length(s) + if i < 0 || i > l { + invalid_arg("String.index_from / Bytes.index_from") + } else { + index_rec(s, l, i, c) + } +} + +/* duplicated in bytes.ml */ +let index_from_opt = (s, i, c) => { + let l = length(s) + if i < 0 || i > l { + invalid_arg("String.index_from_opt / Bytes.index_from_opt") + } else { + index_rec_opt(s, l, i, c) + } +} + +/* duplicated in bytes.ml */ +let rec rindex_rec = (s, i, c) => + if i < 0 { + raise(Not_found) + } else if unsafe_get(s, i) == c { + i + } else { + rindex_rec(s, i - 1, c) + } + +/* duplicated in bytes.ml */ +let rindex = (s, c) => rindex_rec(s, length(s) - 1, c) + +/* duplicated in bytes.ml */ +let rindex_from = (s, i, c) => + if i < -1 || i >= length(s) { + invalid_arg("String.rindex_from / Bytes.rindex_from") + } else { + rindex_rec(s, i, c) + } + +/* duplicated in bytes.ml */ +let rec rindex_rec_opt = (s, i, c) => + if i < 0 { + None + } else if unsafe_get(s, i) == c { + Some(i) + } else { + rindex_rec_opt(s, i - 1, c) + } + +/* duplicated in bytes.ml */ +let rindex_opt = (s, c) => rindex_rec_opt(s, length(s) - 1, c) + +/* duplicated in bytes.ml */ +let rindex_from_opt = (s, i, c) => + if i < -1 || i >= length(s) { + invalid_arg("String.rindex_from_opt / Bytes.rindex_from_opt") + } else { + rindex_rec_opt(s, i, c) + } + +/* duplicated in bytes.ml */ +let contains_from = (s, i, c) => { + let l = length(s) + if i < 0 || i > l { + invalid_arg("String.contains_from / Bytes.contains_from") + } else { + try { + ignore(index_rec(s, l, i, c)) + true + } catch { + | Not_found => false + } + } +} + +/* duplicated in bytes.ml */ +let contains = (s, c) => contains_from(s, 0, c) + +/* duplicated in bytes.ml */ +let rcontains_from = (s, i, c) => + if i < 0 || i >= length(s) { + invalid_arg("String.rcontains_from / Bytes.rcontains_from") + } else { + try { + ignore(rindex_rec(s, i, c)) + true + } catch { + | Not_found => false + } + } + +let uppercase_ascii = s => B.uppercase_ascii(bos(s)) |> bts +let lowercase_ascii = s => B.lowercase_ascii(bos(s)) |> bts +let capitalize_ascii = s => B.capitalize_ascii(bos(s)) |> bts +let uncapitalize_ascii = s => B.uncapitalize_ascii(bos(s)) |> bts + +type t = string + +let compare = (x: t, y: t) => Pervasives.compare(x, y) +let equal: (string, string) => bool = (a, b) => a == b + +let split_on_char = (~sep, s) => { + let r = ref(list{}) + let j = ref(length(s)) + for i in length(s) - 1 downto 0 { + if unsafe_get(s, i) == sep { + r := list{sub(s, ~pos=i + 1, ~len=j.contents - i - 1), ...r.contents} + j := i + } + } + list{sub(s, ~pos=0, ~len=j.contents), ...r.contents} +} diff --git a/jscomp/stdlib-406/stringLabels.resi b/jscomp/stdlib-406/stringLabels.resi new file mode 100644 index 0000000000..8552d17b43 --- /dev/null +++ b/jscomp/stdlib-406/stringLabels.resi @@ -0,0 +1,237 @@ +@@ocaml.text( + /* ************************************************************************ */ + /* */ + /* 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. */ + /* */ + /* ************************************************************************ */ + + " String operations. " +) + +@ocaml.doc(" Return the length (number of characters) of the given string. ") +external length: string => int = "%string_length" + +@ocaml.doc(" [String.get s n] returns the character at index [n] in string [s]. + You can also write [s.[n]] instead of [String.get s n]. + + Raise [Invalid_argument] if [n] not a valid index in [s]. ") +external get: (string, int) => char = "%string_safe_get" + +@ocaml.doc(" [String.make n c] returns a fresh string of length [n], + filled with the character [c]. + + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") +let make: (int, char) => string + +@ocaml.doc(" [init n f] returns a string of length [n], + with character [i] initialized to the result of [f i]. + + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. + @since 4.02.0 ") +let init: (int, ~f: int => char) => string + +@ocaml.doc(" [String.sub s start len] returns a fresh string of length [len], + containing the substring of [s] that starts at position [start] and + has length [len]. + + Raise [Invalid_argument] if [start] and [len] do not + designate a valid substring of [s]. ") +let sub: (string, ~pos: int, ~len: int) => string + +@ocaml.doc(" [String.blit src srcoff dst dstoff len] copies [len] bytes + from the string [src], starting at index [srcoff], + to byte sequence [dst], starting at character number [dstoff]. + + Raise [Invalid_argument] if [srcoff] and [len] do not + designate a valid range of [src], or if [dstoff] and [len] + do not designate a valid range of [dst]. ") +let blit: (~src: string, ~src_pos: int, ~dst: bytes, ~dst_pos: int, ~len: int) => unit + +@ocaml.doc(" [String.concat sep sl] concatenates the list of strings [sl], + inserting the separator string [sep] between each. ") +let concat: (~sep: string, list) => string + +@ocaml.doc(" [String.iter f s] applies function [f] in turn to all + the characters of [s]. It is equivalent to + [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. ") +let iter: (~f: char => unit, string) => unit + +@ocaml.doc(" Same as {!String.iter}, but the + function is applied to the index of the element as first argument + (counting from 0), and the character itself as second argument. + @since 4.00.0 ") +let iteri: (~f: (int, char) => unit, string) => unit + +@ocaml.doc(" [String.map f s] applies function [f] in turn to all + the characters of [s] and stores the results in a new string that + is returned. + @since 4.00.0 ") +let map: (~f: char => char, string) => string + +@ocaml.doc(" [String.mapi f s] calls [f] with each character of [s] and its + index (in increasing index order) and stores the results in a new + string that is returned. + @since 4.02.0 ") +let mapi: (~f: (int, char) => char, string) => string + +@ocaml.doc(" Return a copy of the argument, without leading and trailing + whitespace. The characters regarded as whitespace are: [' '], + ['\012'], ['\n'], ['\r'], and ['\t']. If there is no leading nor + trailing whitespace character in the argument, return the original + string itself, not a copy. + @since 4.00.0 ") +let trim: string => string + +@ocaml.doc(" Return a copy of the argument, with special characters + represented by escape sequences, following the lexical + conventions of OCaml. If there is no special + character in the argument, return the original string itself, + not a copy. Its inverse function is Scanf.unescaped. ") +let escaped: string => string + +@ocaml.doc(" [String.index s c] returns the index of the first + occurrence of character [c] in string [s]. + + Raise [Not_found] if [c] does not occur in [s]. ") +let index: (string, char) => int + +@ocaml.doc(" [String.index_opt s c] returns the index of the first + occurrence of character [c] in string [s], or + [None] if [c] does not occur in [s]. + @since 4.05 ") +let index_opt: (string, char) => option + +@ocaml.doc(" [String.rindex s c] returns the index of the last + occurrence of character [c] in string [s]. + + Raise [Not_found] if [c] does not occur in [s]. ") +let rindex: (string, char) => int + +@ocaml.doc(" [String.rindex_opt s c] returns the index of the last occurrence + of character [c] in string [s], or [None] if [c] does not occur in + [s]. + @since 4.05 ") +let rindex_opt: (string, char) => option + +@ocaml.doc(" [String.index_from s i c] returns the index of the + first occurrence of character [c] in string [s] after position [i]. + [String.index s c] is equivalent to [String.index_from s 0 c]. + + Raise [Invalid_argument] if [i] is not a valid position in [s]. + Raise [Not_found] if [c] does not occur in [s] after position [i]. ") +let index_from: (string, int, char) => int + +@ocaml.doc(" [String.index_from_opt s i c] returns the index of the + first occurrence of character [c] in string [s] after position [i] + or [None] if [c] does not occur in [s] after position [i]. + + [String.index_opt s c] is equivalent to [String.index_from_opt s 0 c]. + Raise [Invalid_argument] if [i] is not a valid position in [s]. + + @since 4.05 +") +let index_from_opt: (string, int, char) => option + +@ocaml.doc(" [String.rindex_from s i c] returns the index of the + last occurrence of character [c] in string [s] before position [i+1]. + [String.rindex s c] is equivalent to + [String.rindex_from s (String.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") +let rindex_from: (string, int, char) => int + +@ocaml.doc(" [String.rindex_from_opt s i c] returns the index of the + last occurrence of character [c] in string [s] before position [i+1] + or [None] if [c] does not occur in [s] before position [i+1]. + + [String.rindex_opt s c] is equivalent to + [String.rindex_from_opt s (String.length s - 1) c]. + + Raise [Invalid_argument] if [i+1] is not a valid position in [s]. + + @since 4.05 +") +let rindex_from_opt: (string, int, char) => option + +@ocaml.doc(" [String.contains s c] tests if character [c] + appears in the string [s]. ") +let contains: (string, char) => bool + +@ocaml.doc(" [String.contains_from s start c] tests if character [c] + appears in [s] after position [start]. + [String.contains s c] is equivalent to + [String.contains_from s 0 c]. + + Raise [Invalid_argument] if [start] is not a valid position in [s]. ") +let contains_from: (string, int, char) => bool + +@ocaml.doc(" [String.rcontains_from s stop c] tests if character [c] + appears in [s] before position [stop+1]. + + Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid + position in [s]. ") +let rcontains_from: (string, int, char) => bool + +@ocaml.doc(" Return a copy of the argument, with all lowercase letters + translated to uppercase, using the US-ASCII character set. + @since 4.05.0 ") +let uppercase_ascii: string => string + +@ocaml.doc(" Return a copy of the argument, with all uppercase letters + translated to lowercase, using the US-ASCII character set. + @since 4.05.0 ") +let lowercase_ascii: string => string + +@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, + using the US-ASCII character set. + @since 4.05.0 ") +let capitalize_ascii: string => string + +@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, + using the US-ASCII character set. + @since 4.05.0 ") +let uncapitalize_ascii: string => string + +@ocaml.doc(" An alias for the type of strings. ") +type t = string + +@ocaml.doc(" The comparison function for strings, with the same specification as + {!Pervasives.compare}. Along with the type [t], this function [compare] + allows the module [String] to be passed as argument to the functors + {!Set.Make} and {!Map.Make}. ") +let compare: (t, t) => int + +@ocaml.doc(" The equal function for strings. + @since 4.05.0 ") +let equal: (t, t) => bool + +@ocaml.doc(" [String.split_on_char sep s] returns the list of all (possibly empty) + substrings of [s] that are delimited by the [sep] character. + + The function's output is specified by the following invariants: + + - The list is not empty. + - Concatenating its elements using [sep] as a separator returns a + string equal to the input ([String.concat (String.make 1 sep) + (String.split_on_char sep s) = s]). + - No string in the result contains the [sep] character. + + @since 4.05.0 +") +let split_on_char: (~sep: char, string) => list + +@@ocaml.text("/*") + +/* The following is for system use only. Do not call directly. */ + +external unsafe_get: (string, int) => char = "%string_unsafe_get" diff --git a/jscomp/stdlib-406/sys.ml b/jscomp/stdlib-406/sys.ml deleted file mode 100644 index 1064b29914..0000000000 --- a/jscomp/stdlib-406/sys.ml +++ /dev/null @@ -1,135 +0,0 @@ -[@@@bs.config { flags = [|"-bs-no-cross-module-opt"; |]}] -#2 "stdlib/sys.mlp" -(**************************************************************************) -(* *) -(* 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. *) -(* *) -(**************************************************************************) - -(* WARNING: sys.ml is generated from sys.mlp. DO NOT EDIT sys.ml or - your changes will be lost. -*) - -type backend_type = - | Native - | Bytecode - | Other of string - (* System interface *) - - -external get_argv: unit -> string * string array = "?sys_get_argv" -external big_endian : unit -> bool = "%big_endian" -external word_size : unit -> int = "%word_size" -external int_size : unit -> int = "%int_size" -(* external max_wosize : unit -> int = "%max_wosize" *) -external unix : unit -> bool = "%ostype_unix" -external win32 : unit -> bool = "%ostype_win32" -external cygwin : unit -> bool = "%ostype_cygwin" -external get_backend_type : unit -> backend_type = "%backend_type" - -let (executable_name, argv) = get_argv() - -external get_os_type : unit -> string = "#os_type" -let os_type = get_os_type () -let backend_type = get_backend_type () -let big_endian = big_endian () -let word_size = word_size () -let int_size = int_size () -let unix = unix () -let win32 = win32 () -let cygwin = cygwin () - -let max_array_length = 2147483647 (* 2^ 31 - 1 *) -let max_string_length = 2147483647 - -external runtime_variant : unit -> string = "?runtime_variant" -external runtime_parameters : unit -> string = "?runtime_parameters" - -external file_exists: string -> bool = "?sys_file_exists" -external is_directory : string -> bool = "?sys_is_directory" -external remove: string -> unit = "?sys_remove" -external rename : string -> string -> unit = "?sys_rename" -external getenv: string -> string = "?sys_getenv" - - -external getEnv : 'a -> string -> string option = "" [@@bs.get_index] -let getenv_opt s = - match [%external process ] with - | None -> None - | Some x -> getEnv x#env s - -let command: string -> int = fun _ -> 127 -external time: unit -> float = - "?sys_time" -external chdir: string -> unit = "?sys_chdir" -external getcwd: unit -> string = "?sys_getcwd" -external readdir : string -> string array = "?sys_read_directory" - -let interactive = ref false - -type signal_behavior = - Signal_default - | Signal_ignore - | Signal_handle of (int -> unit) - -let signal : int -> signal_behavior -> signal_behavior - = fun _ _ -> Signal_default - -let set_signal sig_num sig_beh = ignore(signal sig_num sig_beh) - -let sigabrt = -1 -let sigalrm = -2 -let sigfpe = -3 -let sighup = -4 -let sigill = -5 -let sigint = -6 -let sigkill = -7 -let sigpipe = -8 -let sigquit = -9 -let sigsegv = -10 -let sigterm = -11 -let sigusr1 = -12 -let sigusr2 = -13 -let sigchld = -14 -let sigcont = -15 -let sigstop = -16 -let sigtstp = -17 -let sigttin = -18 -let sigttou = -19 -let sigvtalrm = -20 -let sigprof = -21 -let sigbus = -22 -let sigpoll = -23 -let sigsys = -24 -let sigtrap = -25 -let sigurg = -26 -let sigxcpu = -27 -let sigxfsz = -28 - -exception Break - -let catch_break on = - if on then - set_signal sigint (Signal_handle(fun _ -> raise Break)) - else - set_signal sigint Signal_default - - -let enable_runtime_warnings : bool -> unit = fun _ -> () -let runtime_warnings_enabled : unit -> bool = fun _ -> false -(* The version string is found in file ../VERSION *) - -let ocaml_version = "4.06.2+BS" - -(* Optimization *) - -external opaque_identity : 'a -> 'a = "%opaque" diff --git a/jscomp/stdlib-406/sys.mli b/jscomp/stdlib-406/sys.mli deleted file mode 100644 index a78a4993d6..0000000000 --- a/jscomp/stdlib-406/sys.mli +++ /dev/null @@ -1,333 +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. *) -(* *) -(**************************************************************************) - -(** System interface. - - Every function in this module raises [Sys_error] with an - informative message when the underlying system call signal - an error. -*) - -val argv : string array -(** The command line arguments given to the process. - The first element is the command name used to invoke the program. - The following elements are the command-line arguments - given to the program. *) - -val executable_name : string -(** The name of the file containing the executable currently running. *) - -external file_exists : string -> bool = "?sys_file_exists" -(** Test if a file with the given name exists. *) - -external is_directory : string -> bool = "?sys_is_directory" -(** Returns [true] if the given name refers to a directory, - [false] if it refers to another kind of file. - Raise [Sys_error] if no file exists with the given name. - @since 3.10.0 -*) - -external remove : string -> unit = "?sys_remove" -(** Remove the given file name from the file system. *) - -external rename : string -> string -> unit = "?sys_rename" -(** Rename a file. [rename oldpath newpath] renames the file - called [oldpath], giving it [newpath] as its new name, - moving it between directories if needed. If [newpath] already - exists, its contents will be replaced with those of [oldpath]. - Depending on the operating system, the metadata (permissions, - owner, etc) of [newpath] can either be preserved or be replaced by - those of [oldpath]. - @since 4.06 concerning the "replace existing file" behavior *) - -external getenv : string -> string = "?sys_getenv" -(** Return the value associated to a variable in the process - environment. Raise [Not_found] if the variable is unbound. *) - -val getenv_opt: string -> string option -(** Return the value associated to a variable in the process - environment or [None] if the variable is unbound. - @since 4.05 -*) - -val command : string -> int -(** Execute the given shell command and return its exit code. *) - -external time : unit -> float = - "?sys_time" -(** Return the processor time, in seconds, used by the program - since the beginning of execution. *) - -external chdir : string -> unit = "?sys_chdir" -(** Change the current working directory of the process. *) - -external getcwd : unit -> string = "?sys_getcwd" -(** Return the current working directory of the process. *) - -external readdir : string -> string array = "?sys_read_directory" -(** Return the names of all files present in the given directory. - Names denoting the current directory and the parent directory - (["."] and [".."] in Unix) are not returned. Each string in the - result is a file name rather than a complete path. There is no - guarantee that the name strings in the resulting array will appear - in any specific order; they are not, in particular, guaranteed to - appear in alphabetical order. *) - -val interactive : bool ref -(** This reference is initially set to [false] in standalone - programs and to [true] if the code is being executed under - the interactive toplevel system [ocaml]. *) - -val os_type : string -(** Operating system currently executing the OCaml program. One of -- ["Unix"] (for all Unix versions, including Linux and Mac OS X), -- ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw), -- ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). *) - -type backend_type = - | Native - | Bytecode - | Other of string (**) -(** Currently, the official distribution only supports [Native] and - [Bytecode], but it can be other backends with alternative - compilers, for example, javascript. - - @since 4.04.0 -*) - -val backend_type : backend_type -(** Backend type currently executing the OCaml program. - @since 4.04.0 - *) - -val unix : bool -(** True if [Sys.os_type = "Unix"]. - @since 4.01.0 *) - -val win32 : bool -(** True if [Sys.os_type = "Win32"]. - @since 4.01.0 *) - -val cygwin : bool -(** True if [Sys.os_type = "Cygwin"]. - @since 4.01.0 *) - -val word_size : int -(** Size of one word on the machine currently executing the OCaml - program, in bits: 32 or 64. *) - -val int_size : int -(** Size of an int. It is 31 bits (resp. 63 bits) when using the - OCaml compiler on a 32 bits (resp. 64 bits) platform. It may - differ for other compilers, e.g. it is 32 bits when compiling to - JavaScript. - @since 4.03.0 *) - -val big_endian : bool -(** Whether the machine currently executing the Caml program is big-endian. - @since 4.00.0 *) - -val max_string_length : int -(** Maximum length of strings and byte sequences. *) - -val max_array_length : int -(** Maximum length of a normal array. The maximum length of a float - array is [max_array_length/2] on 32-bit machines and - [max_array_length] on 64-bit machines. *) - -external runtime_variant : unit -> string = "?runtime_variant" -(** Return the name of the runtime variant the program is running on. - This is normally the argument given to [-runtime-variant] at compile - time, but for byte-code it can be changed after compilation. - @since 4.03.0 *) - -external runtime_parameters : unit -> string = "?runtime_parameters" -(** Return the value of the runtime parameters, in the same format - as the contents of the [OCAMLRUNPARAM] environment variable. - @since 4.03.0 *) - - -(** {1 Signal handling} *) - - -type signal_behavior = - Signal_default - | Signal_ignore - | Signal_handle of (int -> unit) (** *) -(** What to do when receiving a signal: - - [Signal_default]: take the default behavior - (usually: abort the program) - - [Signal_ignore]: ignore the signal - - [Signal_handle f]: call function [f], giving it the signal - number as argument. *) - -val signal : - int -> signal_behavior -> signal_behavior -(** Set the behavior of the system on receipt of a given signal. The - first argument is the signal number. Return the behavior - previously associated with the signal. If the signal number is - invalid (or not available on your system), an [Invalid_argument] - exception is raised. *) - -val set_signal : int -> signal_behavior -> unit -(** Same as {!Sys.signal} but return value is ignored. *) - - -(** {2 Signal numbers for the standard POSIX signals.} *) - -val sigabrt : int -(** Abnormal termination *) - -val sigalrm : int -(** Timeout *) - -val sigfpe : int -(** Arithmetic exception *) - -val sighup : int -(** Hangup on controlling terminal *) - -val sigill : int -(** Invalid hardware instruction *) - -val sigint : int -(** Interactive interrupt (ctrl-C) *) - -val sigkill : int -(** Termination (cannot be ignored) *) - -val sigpipe : int -(** Broken pipe *) - -val sigquit : int -(** Interactive termination *) - -val sigsegv : int -(** Invalid memory reference *) - -val sigterm : int -(** Termination *) - -val sigusr1 : int -(** Application-defined signal 1 *) - -val sigusr2 : int -(** Application-defined signal 2 *) - -val sigchld : int -(** Child process terminated *) - -val sigcont : int -(** Continue *) - -val sigstop : int -(** Stop *) - -val sigtstp : int -(** Interactive stop *) - -val sigttin : int -(** Terminal read from background process *) - -val sigttou : int -(** Terminal write from background process *) - -val sigvtalrm : int -(** Timeout in virtual time *) - -val sigprof : int -(** Profiling interrupt *) - -val sigbus : int -(** Bus error - @since 4.03 *) - -val sigpoll : int -(** Pollable event - @since 4.03 *) - -val sigsys : int -(** Bad argument to routine - @since 4.03 *) - -val sigtrap : int -(** Trace/breakpoint trap - @since 4.03 *) - -val sigurg : int -(** Urgent condition on socket - @since 4.03 *) - -val sigxcpu : int -(** Timeout in cpu time - @since 4.03 *) - -val sigxfsz : int -(** File size limit exceeded - @since 4.03 *) - - -exception Break -(** Exception raised on interactive interrupt if {!Sys.catch_break} - is on. *) - - -val catch_break : bool -> unit -(** [catch_break] governs whether interactive interrupt (ctrl-C) - terminates the program or raises the [Break] exception. - Call [catch_break true] to enable raising [Break], - and [catch_break false] to let the system - terminate the program on user interrupt. *) - - -val ocaml_version : string -(** [ocaml_version] is the version of OCaml. - It is a string of the form ["major.minor[.patchlevel][+additional-info]"], - where [major], [minor], and [patchlevel] are integers, and - [additional-info] is an arbitrary string. The [[.patchlevel]] and - [[+additional-info]] parts may be absent. *) - - -val enable_runtime_warnings: bool -> unit -(** Control whether the OCaml runtime system can emit warnings - on stderr. Currently, the only supported warning is triggered - when a channel created by [open_*] functions is finalized without - being closed. Runtime warnings are enabled by default. - - @since 4.03.0 *) - -val runtime_warnings_enabled: unit -> bool -(** Return whether runtime warnings are currently enabled. - - @since 4.03.0 *) - -(** {1 Optimization} *) - -external opaque_identity : 'a -> 'a = "%opaque" -(** For the purposes of optimization, [opaque_identity] behaves like an - unknown (and thus possibly side-effecting) function. - - At runtime, [opaque_identity] disappears altogether. - - A typical use of this function is to prevent pure computations from being - optimized away in benchmarking loops. For example: - {[ - for _round = 1 to 100_000 do - ignore (Sys.opaque_identity (my_pure_computation ())) - done - ]} - - @since 4.03.0 -*) diff --git a/jscomp/stdlib-406/sys.res b/jscomp/stdlib-406/sys.res new file mode 100644 index 0000000000..bffe3aaf29 --- /dev/null +++ b/jscomp/stdlib-406/sys.res @@ -0,0 +1,131 @@ +@@bs.config({flags: ["-bs-no-cross-module-opt"]}) +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* WARNING: sys.ml is generated from sys.mlp. DO NOT EDIT sys.ml or + your changes will be lost. +*/ + +type backend_type = + | Native + | Bytecode + | Other(string) +/* System interface */ + +external get_argv: unit => (string, array) = "?sys_get_argv" +external big_endian: unit => bool = "%big_endian" +external word_size: unit => int = "%word_size" +external int_size: unit => int = "%int_size" +/* external max_wosize : unit -> int = "%max_wosize" */ +external unix: unit => bool = "%ostype_unix" +external win32: unit => bool = "%ostype_win32" +external cygwin: unit => bool = "%ostype_cygwin" +external get_backend_type: unit => backend_type = "%backend_type" + +let (executable_name, argv) = get_argv() + +external get_os_type: unit => string = "#os_type" +let os_type = get_os_type() +let backend_type = get_backend_type() +let big_endian = big_endian() +let word_size = word_size() +let int_size = int_size() +let unix = unix() +let win32 = win32() +let cygwin = cygwin() + +let max_array_length = 2147483647 /* 2^ 31 - 1 */ +let max_string_length = 2147483647 + +external runtime_variant: unit => string = "?runtime_variant" +external runtime_parameters: unit => string = "?runtime_parameters" + +external file_exists: string => bool = "?sys_file_exists" +external is_directory: string => bool = "?sys_is_directory" +external remove: string => unit = "?sys_remove" +external rename: (string, string) => unit = "?sys_rename" +external getenv: string => string = "?sys_getenv" + +@get_index external getEnv: ('a, string) => option = "" +let getenv_opt = s => + switch %external(process) { + | None => None + | Some(x) => getEnv(x["env"], s) + } + +let command: string => int = _ => 127 +external time: unit => float = "?sys_time" +external chdir: string => unit = "?sys_chdir" +external getcwd: unit => string = "?sys_getcwd" +external readdir: string => array = "?sys_read_directory" + +let interactive = ref(false) + +type signal_behavior = + | Signal_default + | Signal_ignore + | Signal_handle(int => unit) + +let signal: (int, signal_behavior) => signal_behavior = (_, _) => Signal_default + +let set_signal = (sig_num, sig_beh) => ignore(signal(sig_num, sig_beh)) + +let sigabrt = -1 +let sigalrm = -2 +let sigfpe = -3 +let sighup = -4 +let sigill = -5 +let sigint = -6 +let sigkill = -7 +let sigpipe = -8 +let sigquit = -9 +let sigsegv = -10 +let sigterm = -11 +let sigusr1 = -12 +let sigusr2 = -13 +let sigchld = -14 +let sigcont = -15 +let sigstop = -16 +let sigtstp = -17 +let sigttin = -18 +let sigttou = -19 +let sigvtalrm = -20 +let sigprof = -21 +let sigbus = -22 +let sigpoll = -23 +let sigsys = -24 +let sigtrap = -25 +let sigurg = -26 +let sigxcpu = -27 +let sigxfsz = -28 + +exception Break + +let catch_break = on => + if on { + set_signal(sigint, Signal_handle(_ => raise(Break))) + } else { + set_signal(sigint, Signal_default) + } + +let enable_runtime_warnings: bool => unit = _ => () +let runtime_warnings_enabled: unit => bool = _ => false +/* The version string is found in file ../VERSION */ + +let ocaml_version = "4.06.2+BS" + +/* Optimization */ + +external opaque_identity: 'a => 'a = "%opaque" diff --git a/jscomp/stdlib-406/sys.resi b/jscomp/stdlib-406/sys.resi new file mode 100644 index 0000000000..10aac3616b --- /dev/null +++ b/jscomp/stdlib-406/sys.resi @@ -0,0 +1,324 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +" System interface. + + Every function in this module raises [Sys_error] with an + informative message when the underlying system call signal + an error. +") + +@ocaml.doc(" The command line arguments given to the process. + The first element is the command name used to invoke the program. + The following elements are the command-line arguments + given to the program. ") +let argv: array + +@ocaml.doc(" The name of the file containing the executable currently running. ") +let executable_name: string + +@ocaml.doc(" Test if a file with the given name exists. ") +external file_exists: string => bool = "?sys_file_exists" + +@ocaml.doc(" Returns [true] if the given name refers to a directory, + [false] if it refers to another kind of file. + Raise [Sys_error] if no file exists with the given name. + @since 3.10.0 +") +external is_directory: string => bool = "?sys_is_directory" + +@ocaml.doc(" Remove the given file name from the file system. ") +external remove: string => unit = "?sys_remove" + +@ocaml.doc(" Rename a file. [rename oldpath newpath] renames the file + called [oldpath], giving it [newpath] as its new name, + moving it between directories if needed. If [newpath] already + exists, its contents will be replaced with those of [oldpath]. + Depending on the operating system, the metadata (permissions, + owner, etc) of [newpath] can either be preserved or be replaced by + those of [oldpath]. + @since 4.06 concerning the \"replace existing file\" behavior ") +external rename: (string, string) => unit = "?sys_rename" + +@ocaml.doc(" Return the value associated to a variable in the process + environment. Raise [Not_found] if the variable is unbound. ") +external getenv: string => string = "?sys_getenv" + +@ocaml.doc(" Return the value associated to a variable in the process + environment or [None] if the variable is unbound. + @since 4.05 +") +let getenv_opt: string => option + +@ocaml.doc(" Execute the given shell command and return its exit code. ") +let command: string => int + +@ocaml.doc(" Return the processor time, in seconds, used by the program + since the beginning of execution. ") +external time: unit => float = "?sys_time" + +@ocaml.doc(" Change the current working directory of the process. ") +external chdir: string => unit = "?sys_chdir" + +@ocaml.doc(" Return the current working directory of the process. ") +external getcwd: unit => string = "?sys_getcwd" + +@ocaml.doc(" Return the names of all files present in the given directory. + Names denoting the current directory and the parent directory + ([\".\"] and [\"..\"] in Unix) are not returned. Each string in the + result is a file name rather than a complete path. There is no + guarantee that the name strings in the resulting array will appear + in any specific order; they are not, in particular, guaranteed to + appear in alphabetical order. ") +external readdir: string => array = "?sys_read_directory" + +@ocaml.doc(" This reference is initially set to [false] in standalone + programs and to [true] if the code is being executed under + the interactive toplevel system [ocaml]. ") +let interactive: ref + +@ocaml.doc(" Operating system currently executing the OCaml program. One of +- [\"Unix\"] (for all Unix versions, including Linux and Mac OS X), +- [\"Win32\"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw), +- [\"Cygwin\"] (for MS-Windows, OCaml compiled with Cygwin). ") +let os_type: string + +@ocaml.doc(" Currently, the official distribution only supports [Native] and + [Bytecode], but it can be other backends with alternative + compilers, for example, javascript. + + @since 4.04.0 +") +type backend_type = + | Native + | Bytecode + | Other(string) + +@ocaml.doc(" Backend type currently executing the OCaml program. + @since 4.04.0 + ") +let backend_type: backend_type + +@ocaml.doc(" True if [Sys.os_type = \"Unix\"]. + @since 4.01.0 ") +let unix: bool + +@ocaml.doc(" True if [Sys.os_type = \"Win32\"]. + @since 4.01.0 ") +let win32: bool + +@ocaml.doc(" True if [Sys.os_type = \"Cygwin\"]. + @since 4.01.0 ") +let cygwin: bool + +@ocaml.doc(" Size of one word on the machine currently executing the OCaml + program, in bits: 32 or 64. ") +let word_size: int + +@ocaml.doc(" Size of an int. It is 31 bits (resp. 63 bits) when using the + OCaml compiler on a 32 bits (resp. 64 bits) platform. It may + differ for other compilers, e.g. it is 32 bits when compiling to + JavaScript. + @since 4.03.0 ") +let int_size: int + +@ocaml.doc(" Whether the machine currently executing the Caml program is big-endian. + @since 4.00.0 ") +let big_endian: bool + +@ocaml.doc(" Maximum length of strings and byte sequences. ") +let max_string_length: int + +@ocaml.doc(" Maximum length of a normal array. The maximum length of a float + array is [max_array_length/2] on 32-bit machines and + [max_array_length] on 64-bit machines. ") +let max_array_length: int + +@ocaml.doc(" Return the name of the runtime variant the program is running on. + This is normally the argument given to [-runtime-variant] at compile + time, but for byte-code it can be changed after compilation. + @since 4.03.0 ") +external runtime_variant: unit => string = "?runtime_variant" + +@ocaml.doc(" Return the value of the runtime parameters, in the same format + as the contents of the [OCAMLRUNPARAM] environment variable. + @since 4.03.0 ") +external runtime_parameters: unit => string = "?runtime_parameters" + +@@ocaml.text(" {1 Signal handling} ") + +@ocaml.doc(" What to do when receiving a signal: + - [Signal_default]: take the default behavior + (usually: abort the program) + - [Signal_ignore]: ignore the signal + - [Signal_handle f]: call function [f], giving it the signal + number as argument. ") +type signal_behavior = + | Signal_default + | Signal_ignore + | @ocaml.doc(" ") Signal_handle(int => unit) + +@ocaml.doc(" Set the behavior of the system on receipt of a given signal. The + first argument is the signal number. Return the behavior + previously associated with the signal. If the signal number is + invalid (or not available on your system), an [Invalid_argument] + exception is raised. ") +let signal: (int, signal_behavior) => signal_behavior + +@ocaml.doc(" Same as {!Sys.signal} but return value is ignored. ") +let set_signal: (int, signal_behavior) => unit + +@@ocaml.text(" {2 Signal numbers for the standard POSIX signals.} ") + +@ocaml.doc(" Abnormal termination ") +let sigabrt: int + +@ocaml.doc(" Timeout ") +let sigalrm: int + +@ocaml.doc(" Arithmetic exception ") +let sigfpe: int + +@ocaml.doc(" Hangup on controlling terminal ") +let sighup: int + +@ocaml.doc(" Invalid hardware instruction ") +let sigill: int + +@ocaml.doc(" Interactive interrupt (ctrl-C) ") +let sigint: int + +@ocaml.doc(" Termination (cannot be ignored) ") +let sigkill: int + +@ocaml.doc(" Broken pipe ") +let sigpipe: int + +@ocaml.doc(" Interactive termination ") +let sigquit: int + +@ocaml.doc(" Invalid memory reference ") +let sigsegv: int + +@ocaml.doc(" Termination ") +let sigterm: int + +@ocaml.doc(" Application-defined signal 1 ") +let sigusr1: int + +@ocaml.doc(" Application-defined signal 2 ") +let sigusr2: int + +@ocaml.doc(" Child process terminated ") +let sigchld: int + +@ocaml.doc(" Continue ") +let sigcont: int + +@ocaml.doc(" Stop ") +let sigstop: int + +@ocaml.doc(" Interactive stop ") +let sigtstp: int + +@ocaml.doc(" Terminal read from background process ") +let sigttin: int + +@ocaml.doc(" Terminal write from background process ") +let sigttou: int + +@ocaml.doc(" Timeout in virtual time ") +let sigvtalrm: int + +@ocaml.doc(" Profiling interrupt ") +let sigprof: int + +@ocaml.doc(" Bus error + @since 4.03 ") +let sigbus: int + +@ocaml.doc(" Pollable event + @since 4.03 ") +let sigpoll: int + +@ocaml.doc(" Bad argument to routine + @since 4.03 ") +let sigsys: int + +@ocaml.doc(" Trace/breakpoint trap + @since 4.03 ") +let sigtrap: int + +@ocaml.doc(" Urgent condition on socket + @since 4.03 ") +let sigurg: int + +@ocaml.doc(" Timeout in cpu time + @since 4.03 ") +let sigxcpu: int + +@ocaml.doc(" File size limit exceeded + @since 4.03 ") +let sigxfsz: int + +@ocaml.doc(" Exception raised on interactive interrupt if {!Sys.catch_break} + is on. ") +exception Break + +@ocaml.doc(" [catch_break] governs whether interactive interrupt (ctrl-C) + terminates the program or raises the [Break] exception. + Call [catch_break true] to enable raising [Break], + and [catch_break false] to let the system + terminate the program on user interrupt. ") +let catch_break: bool => unit + +@ocaml.doc(" [ocaml_version] is the version of OCaml. + It is a string of the form [\"major.minor[.patchlevel][+additional-info]\"], + where [major], [minor], and [patchlevel] are integers, and + [additional-info] is an arbitrary string. The [[.patchlevel]] and + [[+additional-info]] parts may be absent. ") +let ocaml_version: string + +@ocaml.doc(" Control whether the OCaml runtime system can emit warnings + on stderr. Currently, the only supported warning is triggered + when a channel created by [open_*] functions is finalized without + being closed. Runtime warnings are enabled by default. + + @since 4.03.0 ") +let enable_runtime_warnings: bool => unit + +@ocaml.doc(" Return whether runtime warnings are currently enabled. + + @since 4.03.0 ") +let runtime_warnings_enabled: unit => bool + +@@ocaml.text(" {1 Optimization} ") + +@ocaml.doc(" For the purposes of optimization, [opaque_identity] behaves like an + unknown (and thus possibly side-effecting) function. + + At runtime, [opaque_identity] disappears altogether. + + A typical use of this function is to prevent pure computations from being + optimized away in benchmarking loops. For example: + {[ + for _round = 1 to 100_000 do + ignore (Sys.opaque_identity (my_pure_computation ())) + done + ]} + + @since 4.03.0 +") +external opaque_identity: 'a => 'a = "%opaque" diff --git a/jscomp/stdlib-406/uchar.ml b/jscomp/stdlib-406/uchar.ml deleted file mode 100644 index 4f6b1a2a3c..0000000000 --- a/jscomp/stdlib-406/uchar.ml +++ /dev/null @@ -1,58 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Daniel C. Buenzli *) -(* *) -(* Copyright 2014 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. *) -(* *) -(**************************************************************************) - -external format_int : string -> int -> string = "?format_int" - -let err_no_pred = "U+0000 has no predecessor" -let err_no_succ = "U+10FFFF has no successor" -let err_not_sv i = format_int "%X" i ^ " is not an Unicode scalar value" -let err_not_latin1 u = "U+" ^ format_int "%04X" u ^ " is not a latin1 character" - -type t = int - -let min = 0x0000 -let max = 0x10FFFF -let lo_bound = 0xD7FF -let hi_bound = 0xE000 - -let bom = 0xFEFF -let rep = 0xFFFD - -let succ u = - if u = lo_bound then hi_bound else - if u = max then invalid_arg err_no_succ else - u + 1 - -let pred u = - if u = hi_bound then lo_bound else - if u = min then invalid_arg err_no_pred else - u - 1 - -let is_valid i = (min <= i && i <= lo_bound) || (hi_bound <= i && i <= max) -let of_int i = if is_valid i then i else invalid_arg (err_not_sv i) -external unsafe_of_int : int -> t = "%identity" -external to_int : t -> int = "%identity" - -let is_char u = u < 256 -let of_char c = Char.code c -let to_char u = - if u > 255 then invalid_arg (err_not_latin1 u) else - Char.unsafe_chr u - -let unsafe_to_char = Char.unsafe_chr - -let equal : int -> int -> bool = ( = ) -let compare : int -> int -> int = Pervasives.compare -let hash = to_int diff --git a/jscomp/stdlib-406/uchar.mli b/jscomp/stdlib-406/uchar.mli deleted file mode 100644 index c8b63bdbd5..0000000000 --- a/jscomp/stdlib-406/uchar.mli +++ /dev/null @@ -1,98 +0,0 @@ -(**************************************************************************) -(* *) -(* OCaml *) -(* *) -(* Daniel C. Buenzli *) -(* *) -(* Copyright 2014 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. *) -(* *) -(**************************************************************************) - -(** Unicode characters. - - @since 4.03 *) - -type t -(** The type for Unicode characters. - - A value of this type represents an Unicode - {{:http://unicode.org/glossary/#unicode_scalar_value}scalar - value} which is an integer in the ranges [0x0000]...[0xD7FF] or - [0xE000]...[0x10FFFF]. *) - -val min : t -(** [min] is U+0000. *) - -val max : t -(** [max] is U+10FFFF. *) - -val bom : t -(** [bom] is U+FEFF, the - {{:http://unicode.org/glossary/#byte_order_mark}byte order mark} (BOM) - character. - - @since 4.06.0 *) - -val rep : t -(** [rep] is U+FFFD, the - {{:http://unicode.org/glossary/#replacement_character}replacement} - character. - - @since 4.06.0 *) - -val succ : t -> t -(** [succ u] is the scalar value after [u] in the set of Unicode scalar - values. - - @raise Invalid_argument if [u] is {!max}. *) - -val pred : t -> t -(** [pred u] is the scalar value before [u] in the set of Unicode scalar - values. - - @raise Invalid_argument if [u] is {!min}. *) - -val is_valid : int -> bool -(** [is_valid n] is [true] iff [n] is an Unicode scalar value - (i.e. in the ranges [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]).*) - -val of_int : int -> t -(** [of_int i] is [i] as an Unicode character. - - @raise Invalid_argument if [i] does not satisfy {!is_valid}. *) - -(**/**) -val unsafe_of_int : int -> t -(**/**) - -val to_int : t -> int -(** [to_int u] is [u] as an integer. *) - -val is_char : t -> bool -(** [is_char u] is [true] iff [u] is a latin1 OCaml character. *) - -val of_char : char -> t -(** [of_char c] is [c] as an Unicode character. *) - -val to_char : t -> char -(** [to_char u] is [u] as an OCaml latin1 character. - - @raise Invalid_argument if [u] does not satisfy {!is_char}. *) - -(**/**) -val unsafe_to_char : t -> char -(**/**) - -val equal : t -> t -> bool -(** [equal u u'] is [u = u']. *) - -val compare : t -> t -> int -(** [compare u u'] is [Pervasives.compare u u']. *) - -val hash : t -> int -(** [hash u] associates a non-negative integer to [u]. *) diff --git a/jscomp/stdlib-406/uchar.res b/jscomp/stdlib-406/uchar.res new file mode 100644 index 0000000000..de27d35e75 --- /dev/null +++ b/jscomp/stdlib-406/uchar.res @@ -0,0 +1,74 @@ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Daniel C. Buenzli */ +/* */ +/* Copyright 2014 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. */ +/* */ +/* ************************************************************************ */ + +external format_int: (string, int) => string = "?format_int" + +let err_no_pred = "U+0000 has no predecessor" +let err_no_succ = "U+10FFFF has no successor" +let err_not_sv = i => format_int("%X", i) ++ " is not an Unicode scalar value" +let err_not_latin1 = u => "U+" ++ (format_int("%04X", u) ++ " is not a latin1 character") + +type t = int + +let min = 0x0000 +let max = 0x10FFFF +let lo_bound = 0xD7FF +let hi_bound = 0xE000 + +let bom = 0xFEFF +let rep = 0xFFFD + +let succ = u => + if u == lo_bound { + hi_bound + } else if u == max { + invalid_arg(err_no_succ) + } else { + u + 1 + } + +let pred = u => + if u == hi_bound { + lo_bound + } else if u == min { + invalid_arg(err_no_pred) + } else { + u - 1 + } + +let is_valid = i => (min <= i && i <= lo_bound) || (hi_bound <= i && i <= max) +let of_int = i => + if is_valid(i) { + i + } else { + invalid_arg(err_not_sv(i)) + } +external unsafe_of_int: int => t = "%identity" +external to_int: t => int = "%identity" + +let is_char = u => u < 256 +let of_char = c => Char.code(c) +let to_char = u => + if u > 255 { + invalid_arg(err_not_latin1(u)) + } else { + Char.unsafe_chr(u) + } + +let unsafe_to_char = Char.unsafe_chr + +let equal: (int, int) => bool = \"=" +let compare: (int, int) => int = Pervasives.compare +let hash = to_int diff --git a/jscomp/stdlib-406/uchar.resi b/jscomp/stdlib-406/uchar.resi new file mode 100644 index 0000000000..79e22862cb --- /dev/null +++ b/jscomp/stdlib-406/uchar.resi @@ -0,0 +1,98 @@ +@@ocaml.text(/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Daniel C. Buenzli */ +/* */ +/* Copyright 2014 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. */ +/* */ +/* ************************************************************************ */ + +" Unicode characters. + + @since 4.03 ") + +@ocaml.doc(" The type for Unicode characters. + + A value of this type represents an Unicode + {{:http://unicode.org/glossary/#unicode_scalar_value}scalar + value} which is an integer in the ranges [0x0000]...[0xD7FF] or + [0xE000]...[0x10FFFF]. ") +type t + +@ocaml.doc(" [min] is U+0000. ") +let min: t + +@ocaml.doc(" [max] is U+10FFFF. ") +let max: t + +@ocaml.doc(" [bom] is U+FEFF, the + {{:http://unicode.org/glossary/#byte_order_mark}byte order mark} (BOM) + character. + + @since 4.06.0 ") +let bom: t + +@ocaml.doc(" [rep] is U+FFFD, the + {{:http://unicode.org/glossary/#replacement_character}replacement} + character. + + @since 4.06.0 ") +let rep: t + +@ocaml.doc(" [succ u] is the scalar value after [u] in the set of Unicode scalar + values. + + @raise Invalid_argument if [u] is {!max}. ") +let succ: t => t + +@ocaml.doc(" [pred u] is the scalar value before [u] in the set of Unicode scalar + values. + + @raise Invalid_argument if [u] is {!min}. ") +let pred: t => t + +@ocaml.doc(" [is_valid n] is [true] iff [n] is an Unicode scalar value + (i.e. in the ranges [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]).") +let is_valid: int => bool + +@ocaml.doc(" [of_int i] is [i] as an Unicode character. + + @raise Invalid_argument if [i] does not satisfy {!is_valid}. ") +let of_int: int => t + +@@ocaml.text("/*") +let unsafe_of_int: int => t +@@ocaml.text("/*") + +@ocaml.doc(" [to_int u] is [u] as an integer. ") +let to_int: t => int + +@ocaml.doc(" [is_char u] is [true] iff [u] is a latin1 OCaml character. ") +let is_char: t => bool + +@ocaml.doc(" [of_char c] is [c] as an Unicode character. ") +let of_char: char => t + +@ocaml.doc(" [to_char u] is [u] as an OCaml latin1 character. + + @raise Invalid_argument if [u] does not satisfy {!is_char}. ") +let to_char: t => char + +@@ocaml.text("/*") +let unsafe_to_char: t => char +@@ocaml.text("/*") + +@ocaml.doc(" [equal u u'] is [u = u']. ") +let equal: (t, t) => bool + +@ocaml.doc(" [compare u u'] is [Pervasives.compare u u']. ") +let compare: (t, t) => int + +@ocaml.doc(" [hash u] associates a non-negative integer to [u]. ") +let hash: t => int diff --git a/lib/es6/array.js b/lib/es6/array.js index a5d9fb07ac..a471786c33 100644 --- a/lib/es6/array.js +++ b/lib/es6/array.js @@ -191,21 +191,21 @@ function list_length(_accu, _param) { }; } -function of_list(l) { - if (!l) { +function of_list(param) { + if (!param) { return []; } - var a = Caml_array.make(list_length(0, l), l.hd); + var a = Caml_array.make(list_length(0, param), param.hd); var _i = 1; - var _param = l.tl; + var _param = param.tl; while(true) { - var param = _param; + var param$1 = _param; var i = _i; - if (!param) { + if (!param$1) { return a; } - a[i] = param.hd; - _param = param.tl; + a[i] = param$1.hd; + _param = param$1.tl; _i = i + 1 | 0; continue ; }; @@ -367,8 +367,8 @@ function sort(cmp, a) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "array.ml", - 236, + "array.res", + 321, 4 ], Error: new Error() diff --git a/lib/es6/arrayLabels.js b/lib/es6/arrayLabels.js index eff734fe9e..6b2e0e47c0 100644 --- a/lib/es6/arrayLabels.js +++ b/lib/es6/arrayLabels.js @@ -191,21 +191,21 @@ function list_length(_accu, _param) { }; } -function of_list(l) { - if (!l) { +function of_list(param) { + if (!param) { return []; } - var a = Caml_array.make(list_length(0, l), l.hd); + var a = Caml_array.make(list_length(0, param), param.hd); var _i = 1; - var _param = l.tl; + var _param = param.tl; while(true) { - var param = _param; + var param$1 = _param; var i = _i; - if (!param) { + if (!param$1) { return a; } - a[i] = param.hd; - _param = param.tl; + a[i] = param$1.hd; + _param = param$1.tl; _i = i + 1 | 0; continue ; }; @@ -367,8 +367,8 @@ function sort(cmp, a) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "arrayLabels.ml", - 236, + "arrayLabels.res", + 321, 4 ], Error: new Error() diff --git a/lib/es6/buffer.js b/lib/es6/buffer.js index 07dc2841ac..8ef660ca24 100644 --- a/lib/es6/buffer.js +++ b/lib/es6/buffer.js @@ -99,9 +99,9 @@ function add_utf_8_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 78, - 19 + "buffer.res", + 98, + 18 ], Error: new Error() }; @@ -145,9 +145,9 @@ function add_utf_8_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 111, - 8 + "buffer.res", + 127, + 9 ], Error: new Error() }; @@ -159,9 +159,9 @@ function add_utf_16be_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 114, - 19 + "buffer.res", + 132, + 18 ], Error: new Error() }; @@ -194,9 +194,9 @@ function add_utf_16be_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 132, - 8 + "buffer.res", + 154, + 9 ], Error: new Error() }; @@ -208,9 +208,9 @@ function add_utf_16le_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 135, - 19 + "buffer.res", + 159, + 18 ], Error: new Error() }; @@ -243,9 +243,9 @@ function add_utf_16le_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 153, - 8 + "buffer.res", + 181, + 9 ], Error: new Error() }; @@ -299,8 +299,8 @@ function closing(param) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 181, + "buffer.res", + 216, 9 ], Error: new Error() diff --git a/lib/es6/bytes.js b/lib/es6/bytes.js index 668bfd32a5..c009825115 100644 --- a/lib/es6/bytes.js +++ b/lib/es6/bytes.js @@ -265,22 +265,22 @@ function sum_lengths(_acc, seplen, _param) { }; } -function concat(sep, l) { - if (!l) { +function concat(sep, param) { + if (!param) { return empty; } var seplen = sep.length; - var dst = Caml_bytes.create(sum_lengths(0, seplen, l)); + var dst = Caml_bytes.create(sum_lengths(0, seplen, param)); var _pos = 0; - var _param = l; + var _param = param; while(true) { - var param = _param; + var param$1 = _param; var pos = _pos; - if (!param) { + if (!param$1) { return dst; } - var tl = param.tl; - var hd = param.hd; + var tl = param$1.tl; + var hd = param$1.hd; if (tl) { unsafe_blit(hd, 0, dst, pos, hd.length); unsafe_blit(sep, 0, dst, pos + hd.length | 0, seplen); diff --git a/lib/es6/bytesLabels.js b/lib/es6/bytesLabels.js index 668bfd32a5..c009825115 100644 --- a/lib/es6/bytesLabels.js +++ b/lib/es6/bytesLabels.js @@ -265,22 +265,22 @@ function sum_lengths(_acc, seplen, _param) { }; } -function concat(sep, l) { - if (!l) { +function concat(sep, param) { + if (!param) { return empty; } var seplen = sep.length; - var dst = Caml_bytes.create(sum_lengths(0, seplen, l)); + var dst = Caml_bytes.create(sum_lengths(0, seplen, param)); var _pos = 0; - var _param = l; + var _param = param; while(true) { - var param = _param; + var param$1 = _param; var pos = _pos; - if (!param) { + if (!param$1) { return dst; } - var tl = param.tl; - var hd = param.hd; + var tl = param$1.tl; + var hd = param$1.hd; if (tl) { unsafe_blit(hd, 0, dst, pos, hd.length); unsafe_blit(sep, 0, dst, pos + hd.length | 0, seplen); diff --git a/lib/es6/camlinternalLazy.js b/lib/es6/camlinternalLazy.js index 697cd9e5de..7b80d775fb 100644 --- a/lib/es6/camlinternalLazy.js +++ b/lib/es6/camlinternalLazy.js @@ -9,7 +9,7 @@ function is_val(l) { var Undefined = /* @__PURE__ */Caml_exceptions.create("CamlinternalLazy.Undefined"); function forward_with_closure(blk, closure) { - var result = closure(); + var result = closure(undefined); blk.VAL = result; blk.LAZY_DONE = true; return result; diff --git a/lib/es6/char.js b/lib/es6/char.js index 71726ab8f1..1b68800a58 100644 --- a/lib/es6/char.js +++ b/lib/es6/char.js @@ -13,22 +13,22 @@ function chr(n) { return n; } -function escaped(c) { +function escaped(param) { var exit = 0; - if (c >= 40) { - if (c === 92) { + if (param >= 40) { + if (param === 92) { return "\\\\"; } - exit = c >= 127 ? 1 : 2; - } else if (c >= 32) { - if (c >= 39) { + exit = param >= 127 ? 1 : 2; + } else if (param >= 32) { + if (param >= 39) { return "\\'"; } exit = 2; - } else if (c >= 14) { + } else if (param >= 14) { exit = 1; } else { - switch (c) { + switch (param) { case 8 : return "\\b"; case 9 : @@ -61,13 +61,13 @@ function escaped(c) { 0 ]; s[0] = /* '\\' */92; - s[1] = 48 + (c / 100 | 0) | 0; - s[2] = 48 + (c / 10 | 0) % 10 | 0; - s[3] = 48 + c % 10 | 0; + s[1] = 48 + (param / 100 | 0) | 0; + s[2] = 48 + (param / 10 | 0) % 10 | 0; + s[3] = 48 + param % 10 | 0; return Bytes.to_string(s); case 2 : var s$1 = [0]; - s$1[0] = c; + s$1[0] = param; return Bytes.to_string(s$1); } diff --git a/lib/es6/hashtbl.js b/lib/es6/hashtbl.js index cebb4dea6d..71dec6eff7 100644 --- a/lib/es6/hashtbl.js +++ b/lib/es6/hashtbl.js @@ -118,9 +118,9 @@ function copy_bucketlist(param) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "hashtbl.ml", - 104, - 23 + "hashtbl.res", + 110, + 19 ], Error: new Error() }; @@ -165,16 +165,16 @@ function resize(indexfun, h) { var ndata_tail = Caml_array.make(nsize, "Empty"); var inplace = h.initial_size >= 0; h.data = ndata; - var insert_bucket = function (_cell) { + var insert_bucket = function (_param) { while(true) { - var cell = _cell; - if (typeof cell !== "object") { + var param = _param; + if (typeof param !== "object") { return ; } - var key = cell.key; - var data = cell.data; - var next = cell.next; - var cell$1 = inplace ? cell : ({ + var key = param.key; + var data = param.data; + var next = param.next; + var cell = inplace ? param : ({ TAG: "Cons", key: key, data: data, @@ -183,12 +183,12 @@ function resize(indexfun, h) { var nidx = Curry._2(indexfun, h, key); var tail = Caml_array.get(ndata_tail, nidx); if (typeof tail !== "object") { - Caml_array.set(ndata, nidx, cell$1); + Caml_array.set(ndata, nidx, cell); } else { - tail.next = cell$1; + tail.next = cell; } - Caml_array.set(ndata_tail, nidx, cell$1); - _cell = next; + Caml_array.set(ndata_tail, nidx, cell); + _param = next; continue ; }; }; @@ -230,15 +230,15 @@ function add(h, key, data) { function remove(h, key) { var i = key_index(h, key); var _prec = "Empty"; - var _c = Caml_array.get(h.data, i); + var _param = Caml_array.get(h.data, i); while(true) { - var c = _c; + var param = _param; var prec = _prec; - if (typeof c !== "object") { + if (typeof param !== "object") { return ; } - var k = c.key; - var next = c.next; + var k = param.key; + var next = param.next; if (Caml_obj.equal(k, key)) { h.size = h.size - 1 | 0; if (typeof prec !== "object") { @@ -248,8 +248,8 @@ function remove(h, key) { return ; } } - _c = next; - _prec = c; + _param = next; + _prec = param; continue ; }; } @@ -383,20 +383,20 @@ function find_all(h, key) { return find_in_bucket(Caml_array.get(h.data, key_index(h, key))); } -function replace_bucket(key, data, _slot) { +function replace_bucket(key, data, _param) { while(true) { - var slot = _slot; - if (typeof slot !== "object") { + var param = _param; + if (typeof param !== "object") { return true; } - var k = slot.key; - var next = slot.next; + var k = param.key; + var next = param.next; if (Caml_obj.equal(k, key)) { - slot.key = key; - slot.data = data; + param.key = key; + param.data = data; return false; } - _slot = next; + _param = next; continue ; }; } @@ -477,11 +477,11 @@ function iter(f, h) { } } -function filter_map_inplace_bucket(f, h, i, _prec, _slot) { +function filter_map_inplace_bucket(f, h, i, _prec, _param) { while(true) { - var slot = _slot; + var param = _param; var prec = _prec; - if (typeof slot !== "object") { + if (typeof param !== "object") { if (typeof prec !== "object") { return Caml_array.set(h.data, i, "Empty"); } else { @@ -489,23 +489,23 @@ function filter_map_inplace_bucket(f, h, i, _prec, _slot) { return ; } } - var key = slot.key; - var data = slot.data; - var next = slot.next; + var key = param.key; + var data = param.data; + var next = param.next; var data$1 = Curry._2(f, key, data); if (data$1 !== undefined) { if (typeof prec !== "object") { - Caml_array.set(h.data, i, slot); + Caml_array.set(h.data, i, param); } else { - prec.next = slot; + prec.next = param; } - slot.data = Caml_option.valFromOption(data$1); - _slot = next; - _prec = slot; + param.data = Caml_option.valFromOption(data$1); + _param = next; + _prec = param; continue ; } h.size = h.size - 1 | 0; - _slot = next; + _param = next; continue ; }; } @@ -624,15 +624,15 @@ function MakeSeeded(H) { var remove = function (h, key) { var i = key_index(h, key); var _prec = "Empty"; - var _c = Caml_array.get(h.data, i); + var _param = Caml_array.get(h.data, i); while(true) { - var c = _c; + var param = _param; var prec = _prec; - if (typeof c !== "object") { + if (typeof param !== "object") { return ; } - var k = c.key; - var next = c.next; + var k = param.key; + var next = param.next; if (Curry._2(H.equal, k, key)) { h.size = h.size - 1 | 0; if (typeof prec !== "object") { @@ -642,8 +642,8 @@ function MakeSeeded(H) { return ; } } - _c = next; - _prec = c; + _param = next; + _prec = param; continue ; }; }; @@ -773,20 +773,20 @@ function MakeSeeded(H) { }; return find_in_bucket(Caml_array.get(h.data, key_index(h, key))); }; - var replace_bucket = function (key, data, _slot) { + var replace_bucket = function (key, data, _param) { while(true) { - var slot = _slot; - if (typeof slot !== "object") { + var param = _param; + if (typeof param !== "object") { return true; } - var k = slot.key; - var next = slot.next; + var k = param.key; + var next = param.next; if (Curry._2(H.equal, k, key)) { - slot.key = key; - slot.data = data; + param.key = key; + param.data = data; return false; } - _slot = next; + _param = next; continue ; }; }; @@ -868,15 +868,15 @@ function Make(H) { var remove = function (h, key) { var i = key_index(h, key); var _prec = "Empty"; - var _c = Caml_array.get(h.data, i); + var _param = Caml_array.get(h.data, i); while(true) { - var c = _c; + var param = _param; var prec = _prec; - if (typeof c !== "object") { + if (typeof param !== "object") { return ; } - var k = c.key; - var next = c.next; + var k = param.key; + var next = param.next; if (Curry._2(equal, k, key)) { h.size = h.size - 1 | 0; if (typeof prec !== "object") { @@ -886,8 +886,8 @@ function Make(H) { return ; } } - _c = next; - _prec = c; + _param = next; + _prec = param; continue ; }; }; @@ -1017,20 +1017,20 @@ function Make(H) { }; return find_in_bucket(Caml_array.get(h.data, key_index(h, key))); }; - var replace_bucket = function (key, data, _slot) { + var replace_bucket = function (key, data, _param) { while(true) { - var slot = _slot; - if (typeof slot !== "object") { + var param = _param; + if (typeof param !== "object") { return true; } - var k = slot.key; - var next = slot.next; + var k = param.key; + var next = param.next; if (Curry._2(equal, k, key)) { - slot.key = key; - slot.data = data; + param.key = key; + param.data = data; return false; } - _slot = next; + _param = next; continue ; }; }; diff --git a/lib/es6/list.js b/lib/es6/list.js index 8c0313764a..3303234073 100644 --- a/lib/es6/list.js +++ b/lib/es6/list.js @@ -823,8 +823,8 @@ function chop(_k, _l) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "list.ml", - 262, + "list.res", + 420, 11 ], Error: new Error() diff --git a/lib/es6/listLabels.js b/lib/es6/listLabels.js index 946c6c2596..25e0b60d63 100644 --- a/lib/es6/listLabels.js +++ b/lib/es6/listLabels.js @@ -823,8 +823,8 @@ function chop(_k, _l) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "listLabels.ml", - 262, + "listLabels.res", + 420, 11 ], Error: new Error() diff --git a/lib/es6/map.js b/lib/es6/map.js index 91a7429f04..24f7f3f562 100644 --- a/lib/es6/map.js +++ b/lib/es6/map.js @@ -102,8 +102,8 @@ function Make(funarg) { return false; } }; - var add = function (x, data, m) { - if (typeof m !== "object") { + var add = function (x, data, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -113,14 +113,14 @@ function Make(funarg) { h: 1 }; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { if (d === data) { - return m; + return param; } else { return { TAG: "Node", @@ -128,21 +128,21 @@ function Make(funarg) { v: x, d: data, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = add(x, data, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = add(x, data, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -441,14 +441,14 @@ function Make(funarg) { var match = min_binding(t2); return bal(t1, match[0], match[1], remove_min_binding(t2)); }; - var remove = function (x, m) { - if (typeof m !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { return merge(l, r); @@ -456,20 +456,20 @@ function Make(funarg) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = remove(x, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } }; - var update = function (x, f, m) { - if (typeof m !== "object") { + var update = function (x, f, param) { + if (typeof param !== "object") { var data = Curry._1(f, undefined); if (data !== undefined) { return { @@ -484,10 +484,10 @@ function Make(funarg) { return "Empty"; } } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { var data$1 = Curry._1(f, Caml_option.some(d)); @@ -496,7 +496,7 @@ function Make(funarg) { } var data$2 = Caml_option.valFromOption(data$1); if (d === data$2) { - return m; + return param; } else { return { TAG: "Node", @@ -504,21 +504,21 @@ function Make(funarg) { v: x, d: data$2, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = update(x, f, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = update(x, f, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -713,9 +713,9 @@ function Make(funarg) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "map.ml", - 393, - 10 + "map.res", + 552, + 11 ], Error: new Error() }; @@ -756,20 +756,20 @@ function Make(funarg) { return join(l$1, v2, d2, r$1); } }; - var filter = function (p, m) { - if (typeof m !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pvd = Curry._2(p, v, d); var r$p = filter(p, r); if (pvd) { if (l === l$p && r === r$p) { - return m; + return param; } else { return join(l$p, v, d, r$p); } diff --git a/lib/es6/mapLabels.js b/lib/es6/mapLabels.js index f30f682b0e..5922b203db 100644 --- a/lib/es6/mapLabels.js +++ b/lib/es6/mapLabels.js @@ -102,8 +102,8 @@ function Make(Ord) { return false; } }; - var add = function (x, data, m) { - if (typeof m !== "object") { + var add = function (x, data, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -113,14 +113,14 @@ function Make(Ord) { h: 1 }; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { if (d === data) { - return m; + return param; } else { return { TAG: "Node", @@ -128,21 +128,21 @@ function Make(Ord) { v: x, d: data, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = add(x, data, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = add(x, data, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -441,14 +441,14 @@ function Make(Ord) { var match = min_binding(t2); return bal(t1, match[0], match[1], remove_min_binding(t2)); }; - var remove = function (x, m) { - if (typeof m !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { return merge(l, r); @@ -456,20 +456,20 @@ function Make(Ord) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = remove(x, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } }; - var update = function (x, f, m) { - if (typeof m !== "object") { + var update = function (x, f, param) { + if (typeof param !== "object") { var data = Curry._1(f, undefined); if (data !== undefined) { return { @@ -484,10 +484,10 @@ function Make(Ord) { return "Empty"; } } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { var data$1 = Curry._1(f, Caml_option.some(d)); @@ -496,7 +496,7 @@ function Make(Ord) { } var data$2 = Caml_option.valFromOption(data$1); if (d === data$2) { - return m; + return param; } else { return { TAG: "Node", @@ -504,21 +504,21 @@ function Make(Ord) { v: x, d: data$2, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = update(x, f, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = update(x, f, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -713,9 +713,9 @@ function Make(Ord) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "mapLabels.ml", - 393, - 10 + "mapLabels.res", + 552, + 11 ], Error: new Error() }; @@ -756,20 +756,20 @@ function Make(Ord) { return join(l$1, v2, d2, r$1); } }; - var filter = function (p, m) { - if (typeof m !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pvd = Curry._2(p, v, d); var r$p = filter(p, r); if (pvd) { if (l === l$p && r === r$p) { - return m; + return param; } else { return join(l$p, v, d, r$p); } diff --git a/lib/es6/moreLabels.js b/lib/es6/moreLabels.js index b3dcca38d3..61f6a97973 100644 --- a/lib/es6/moreLabels.js +++ b/lib/es6/moreLabels.js @@ -132,8 +132,8 @@ var $$Map = { return false; } }; - var add = function (x, data, m) { - if (typeof m !== "object") { + var add = function (x, data, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -143,14 +143,14 @@ var $$Map = { h: 1 }; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { if (d === data) { - return m; + return param; } else { return { TAG: "Node", @@ -158,21 +158,21 @@ var $$Map = { v: x, d: data, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = add(x, data, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = add(x, data, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -471,14 +471,14 @@ var $$Map = { var match = min_binding(t2); return bal(t1, match[0], match[1], remove_min_binding(t2)); }; - var remove = function (x, m) { - if (typeof m !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { return merge(l, r); @@ -486,20 +486,20 @@ var $$Map = { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = remove(x, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } }; - var update = function (x, f, m) { - if (typeof m !== "object") { + var update = function (x, f, param) { + if (typeof param !== "object") { var data = Curry._1(f, undefined); if (data !== undefined) { return { @@ -514,10 +514,10 @@ var $$Map = { return "Empty"; } } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { var data$1 = Curry._1(f, Caml_option.some(d)); @@ -526,7 +526,7 @@ var $$Map = { } var data$2 = Caml_option.valFromOption(data$1); if (d === data$2) { - return m; + return param; } else { return { TAG: "Node", @@ -534,21 +534,21 @@ var $$Map = { v: x, d: data$2, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = update(x, f, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = update(x, f, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -743,9 +743,9 @@ var $$Map = { throw { RE_EXN_ID: "Assert_failure", _1: [ - "mapLabels.ml", - 393, - 10 + "mapLabels.res", + 552, + 11 ], Error: new Error() }; @@ -786,20 +786,20 @@ var $$Map = { return join(l$1, v2, d2, r$1); } }; - var filter = function (p, m) { - if (typeof m !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pvd = Curry._2(p, v, d); var r$p = filter(p, r); if (pvd) { if (l === l$p && r === r$p) { - return m; + return param; } else { return join(l$p, v, d, r$p); } @@ -1057,8 +1057,8 @@ var $$Set = { Error: new Error() }; }; - var add = function (x, t) { - if (typeof t !== "object") { + var add = function (x, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -1067,24 +1067,24 @@ var $$Set = { h: 1 }; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { - return t; + return param; } if (c < 0) { var ll = add(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = add(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -1279,13 +1279,13 @@ var $$Set = { continue ; }; }; - var remove = function (x, t) { - if (typeof t !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { return merge(l, r); @@ -1293,14 +1293,14 @@ var $$Set = { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = remove(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -1517,19 +1517,19 @@ var $$Set = { continue ; }; }; - var filter = function (p, t) { - if (typeof t !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pv = Curry._1(p, v); var r$p = filter(p, r); if (pv) { if (l === l$p && r === r$p) { - return t; + return param; } else { return join(l$p, v, r$p); } @@ -1759,18 +1759,18 @@ var $$Set = { return union(l, add(v, r)); } }; - var map = function (f, t) { - if (typeof t !== "object") { + var map = function (f, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = map(f, l); var v$p = Curry._1(f, v); var r$p = map(f, r); if (l === l$p && v === v$p && r === r$p) { - return t; + return param; } else { return try_join(l$p, v$p, r$p); } @@ -1871,9 +1871,9 @@ var $$Set = { throw { RE_EXN_ID: "Assert_failure", _1: [ - "setLabels.ml", - 510, - 18 + "setLabels.res", + 691, + 20 ], Error: new Error() }; diff --git a/lib/es6/set.js b/lib/es6/set.js index 62b4d3a55c..1ec2e2dd90 100644 --- a/lib/es6/set.js +++ b/lib/es6/set.js @@ -84,8 +84,8 @@ function Make(funarg) { Error: new Error() }; }; - var add = function (x, t) { - if (typeof t !== "object") { + var add = function (x, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -94,24 +94,24 @@ function Make(funarg) { h: 1 }; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { - return t; + return param; } if (c < 0) { var ll = add(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = add(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -297,13 +297,13 @@ function Make(funarg) { continue ; }; }; - var remove = function (x, t) { - if (typeof t !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { if (typeof l !== "object") { @@ -317,14 +317,14 @@ function Make(funarg) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = remove(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -540,19 +540,19 @@ function Make(funarg) { continue ; }; }; - var filter = function (p, t) { - if (typeof t !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pv = Curry._1(p, v); var r$p = filter(p, r); if (pv) { if (l === l$p && r === r$p) { - return t; + return param; } else { return join(l$p, v, r$p); } @@ -771,18 +771,18 @@ function Make(funarg) { continue ; }; }; - var map = function (f, t) { - if (typeof t !== "object") { + var map = function (f, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = map(f, l); var v$p = Curry._1(f, v); var r$p = map(f, r); if (l === l$p && v === v$p && r === r$p) { - return t; + return param; } else if ((l$p === "Empty" || Curry._2(funarg.compare, max_elt(l$p), v$p) < 0) && (r$p === "Empty" || Curry._2(funarg.compare, v$p, min_elt(r$p)) < 0)) { return join(l$p, v$p, r$p); } else { @@ -908,9 +908,9 @@ function Make(funarg) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "set.ml", - 510, - 18 + "set.res", + 691, + 20 ], Error: new Error() }; diff --git a/lib/es6/setLabels.js b/lib/es6/setLabels.js index 6efa60a772..fc4e938ec0 100644 --- a/lib/es6/setLabels.js +++ b/lib/es6/setLabels.js @@ -84,8 +84,8 @@ function Make(Ord) { Error: new Error() }; }; - var add = function (x, t) { - if (typeof t !== "object") { + var add = function (x, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -94,24 +94,24 @@ function Make(Ord) { h: 1 }; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { - return t; + return param; } if (c < 0) { var ll = add(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = add(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -306,13 +306,13 @@ function Make(Ord) { continue ; }; }; - var remove = function (x, t) { - if (typeof t !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { return merge(l, r); @@ -320,14 +320,14 @@ function Make(Ord) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = remove(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -544,19 +544,19 @@ function Make(Ord) { continue ; }; }; - var filter = function (p, t) { - if (typeof t !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pv = Curry._1(p, v); var r$p = filter(p, r); if (pv) { if (l === l$p && r === r$p) { - return t; + return param; } else { return join(l$p, v, r$p); } @@ -786,18 +786,18 @@ function Make(Ord) { return union(l, add(v, r)); } }; - var map = function (f, t) { - if (typeof t !== "object") { + var map = function (f, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = map(f, l); var v$p = Curry._1(f, v); var r$p = map(f, r); if (l === l$p && v === v$p && r === r$p) { - return t; + return param; } else { return try_join(l$p, v$p, r$p); } @@ -898,9 +898,9 @@ function Make(Ord) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "setLabels.ml", - 510, - 18 + "setLabels.res", + 691, + 20 ], Error: new Error() }; diff --git a/lib/es6/sort.js b/lib/es6/sort.js index 408e828e40..3309b84cfc 100644 --- a/lib/es6/sort.js +++ b/lib/es6/sort.js @@ -58,30 +58,30 @@ function list(order, l) { tl: initlist(match.tl) }; }; - var merge2 = function (x) { - if (!x) { - return x; + var merge2 = function (param) { + if (!param) { + return param; } - var match = x.tl; + var match = param.tl; if (match) { return { - hd: merge(order, x.hd, match.hd), + hd: merge(order, param.hd, match.hd), tl: merge2(match.tl) }; } else { - return x; + return param; } }; - var _llist = initlist(l); + var _param = initlist(l); while(true) { - var llist = _llist; - if (!llist) { + var param = _param; + if (!param) { return /* [] */0; } - if (!llist.tl) { - return llist.hd; + if (!param.tl) { + return param.hd; } - _llist = merge2(llist); + _param = merge2(param); continue ; }; } diff --git a/lib/es6/stream.js b/lib/es6/stream.js index cc68b8e2ac..9352357c60 100644 --- a/lib/es6/stream.js +++ b/lib/es6/stream.js @@ -58,9 +58,9 @@ function get_data(count, _d) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "stream.ml", - 48, - 12 + "stream.res", + 53, + 13 ], Error: new Error() }; @@ -120,9 +120,9 @@ function peek_data(s) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "stream.ml", - 71, - 12 + "stream.res", + 83, + 13 ], Error: new Error() }; @@ -143,9 +143,9 @@ function peek_data(s) { }; } -function peek(s) { - if (s !== undefined) { - return peek_data(s); +function peek(param) { + if (param !== undefined) { + return peek_data(param); } } @@ -180,9 +180,9 @@ function junk_data(s) { }; } -function junk(data) { - if (data !== undefined) { - return junk_data(data); +function junk(param) { + if (param !== undefined) { + return junk_data(param); } } @@ -220,11 +220,11 @@ function nget_data(n, s) { ]; } -function npeek(n, d) { - if (d !== undefined) { - var match = nget_data(n, d); - d.count = d.count - match[2] | 0; - d.data = match[1]; +function npeek(n, param) { + if (param !== undefined) { + var match = nget_data(n, param); + param.count = param.count - match[2] | 0; + param.data = match[1]; return match[0]; } else { return /* [] */0; diff --git a/lib/js/array.js b/lib/js/array.js index e668e543a7..016c51f289 100644 --- a/lib/js/array.js +++ b/lib/js/array.js @@ -191,21 +191,21 @@ function list_length(_accu, _param) { }; } -function of_list(l) { - if (!l) { +function of_list(param) { + if (!param) { return []; } - var a = Caml_array.make(list_length(0, l), l.hd); + var a = Caml_array.make(list_length(0, param), param.hd); var _i = 1; - var _param = l.tl; + var _param = param.tl; while(true) { - var param = _param; + var param$1 = _param; var i = _i; - if (!param) { + if (!param$1) { return a; } - a[i] = param.hd; - _param = param.tl; + a[i] = param$1.hd; + _param = param$1.tl; _i = i + 1 | 0; continue ; }; @@ -367,8 +367,8 @@ function sort(cmp, a) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "array.ml", - 236, + "array.res", + 321, 4 ], Error: new Error() diff --git a/lib/js/arrayLabels.js b/lib/js/arrayLabels.js index 69d38745c0..cb25b43970 100644 --- a/lib/js/arrayLabels.js +++ b/lib/js/arrayLabels.js @@ -191,21 +191,21 @@ function list_length(_accu, _param) { }; } -function of_list(l) { - if (!l) { +function of_list(param) { + if (!param) { return []; } - var a = Caml_array.make(list_length(0, l), l.hd); + var a = Caml_array.make(list_length(0, param), param.hd); var _i = 1; - var _param = l.tl; + var _param = param.tl; while(true) { - var param = _param; + var param$1 = _param; var i = _i; - if (!param) { + if (!param$1) { return a; } - a[i] = param.hd; - _param = param.tl; + a[i] = param$1.hd; + _param = param$1.tl; _i = i + 1 | 0; continue ; }; @@ -367,8 +367,8 @@ function sort(cmp, a) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "arrayLabels.ml", - 236, + "arrayLabels.res", + 321, 4 ], Error: new Error() diff --git a/lib/js/buffer.js b/lib/js/buffer.js index 7a21306cd9..9b0720b7fe 100644 --- a/lib/js/buffer.js +++ b/lib/js/buffer.js @@ -99,9 +99,9 @@ function add_utf_8_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 78, - 19 + "buffer.res", + 98, + 18 ], Error: new Error() }; @@ -145,9 +145,9 @@ function add_utf_8_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 111, - 8 + "buffer.res", + 127, + 9 ], Error: new Error() }; @@ -159,9 +159,9 @@ function add_utf_16be_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 114, - 19 + "buffer.res", + 132, + 18 ], Error: new Error() }; @@ -194,9 +194,9 @@ function add_utf_16be_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 132, - 8 + "buffer.res", + 154, + 9 ], Error: new Error() }; @@ -208,9 +208,9 @@ function add_utf_16le_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 135, - 19 + "buffer.res", + 159, + 18 ], Error: new Error() }; @@ -243,9 +243,9 @@ function add_utf_16le_uchar(b, u) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 153, - 8 + "buffer.res", + 181, + 9 ], Error: new Error() }; @@ -299,8 +299,8 @@ function closing(param) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "buffer.ml", - 181, + "buffer.res", + 216, 9 ], Error: new Error() diff --git a/lib/js/bytes.js b/lib/js/bytes.js index a8983609aa..38a3229018 100644 --- a/lib/js/bytes.js +++ b/lib/js/bytes.js @@ -265,22 +265,22 @@ function sum_lengths(_acc, seplen, _param) { }; } -function concat(sep, l) { - if (!l) { +function concat(sep, param) { + if (!param) { return empty; } var seplen = sep.length; - var dst = Caml_bytes.create(sum_lengths(0, seplen, l)); + var dst = Caml_bytes.create(sum_lengths(0, seplen, param)); var _pos = 0; - var _param = l; + var _param = param; while(true) { - var param = _param; + var param$1 = _param; var pos = _pos; - if (!param) { + if (!param$1) { return dst; } - var tl = param.tl; - var hd = param.hd; + var tl = param$1.tl; + var hd = param$1.hd; if (tl) { unsafe_blit(hd, 0, dst, pos, hd.length); unsafe_blit(sep, 0, dst, pos + hd.length | 0, seplen); diff --git a/lib/js/bytesLabels.js b/lib/js/bytesLabels.js index a8983609aa..38a3229018 100644 --- a/lib/js/bytesLabels.js +++ b/lib/js/bytesLabels.js @@ -265,22 +265,22 @@ function sum_lengths(_acc, seplen, _param) { }; } -function concat(sep, l) { - if (!l) { +function concat(sep, param) { + if (!param) { return empty; } var seplen = sep.length; - var dst = Caml_bytes.create(sum_lengths(0, seplen, l)); + var dst = Caml_bytes.create(sum_lengths(0, seplen, param)); var _pos = 0; - var _param = l; + var _param = param; while(true) { - var param = _param; + var param$1 = _param; var pos = _pos; - if (!param) { + if (!param$1) { return dst; } - var tl = param.tl; - var hd = param.hd; + var tl = param$1.tl; + var hd = param$1.hd; if (tl) { unsafe_blit(hd, 0, dst, pos, hd.length); unsafe_blit(sep, 0, dst, pos + hd.length | 0, seplen); diff --git a/lib/js/camlinternalLazy.js b/lib/js/camlinternalLazy.js index f812859e83..867d359675 100644 --- a/lib/js/camlinternalLazy.js +++ b/lib/js/camlinternalLazy.js @@ -9,7 +9,7 @@ function is_val(l) { var Undefined = /* @__PURE__ */Caml_exceptions.create("CamlinternalLazy.Undefined"); function forward_with_closure(blk, closure) { - var result = closure(); + var result = closure(undefined); blk.VAL = result; blk.LAZY_DONE = true; return result; diff --git a/lib/js/char.js b/lib/js/char.js index d460d0dbc4..e6dedb9fc4 100644 --- a/lib/js/char.js +++ b/lib/js/char.js @@ -13,22 +13,22 @@ function chr(n) { return n; } -function escaped(c) { +function escaped(param) { var exit = 0; - if (c >= 40) { - if (c === 92) { + if (param >= 40) { + if (param === 92) { return "\\\\"; } - exit = c >= 127 ? 1 : 2; - } else if (c >= 32) { - if (c >= 39) { + exit = param >= 127 ? 1 : 2; + } else if (param >= 32) { + if (param >= 39) { return "\\'"; } exit = 2; - } else if (c >= 14) { + } else if (param >= 14) { exit = 1; } else { - switch (c) { + switch (param) { case 8 : return "\\b"; case 9 : @@ -61,13 +61,13 @@ function escaped(c) { 0 ]; s[0] = /* '\\' */92; - s[1] = 48 + (c / 100 | 0) | 0; - s[2] = 48 + (c / 10 | 0) % 10 | 0; - s[3] = 48 + c % 10 | 0; + s[1] = 48 + (param / 100 | 0) | 0; + s[2] = 48 + (param / 10 | 0) % 10 | 0; + s[3] = 48 + param % 10 | 0; return Bytes.to_string(s); case 2 : var s$1 = [0]; - s$1[0] = c; + s$1[0] = param; return Bytes.to_string(s$1); } diff --git a/lib/js/hashtbl.js b/lib/js/hashtbl.js index bdbb33cf5d..72aeaf29ef 100644 --- a/lib/js/hashtbl.js +++ b/lib/js/hashtbl.js @@ -118,9 +118,9 @@ function copy_bucketlist(param) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "hashtbl.ml", - 104, - 23 + "hashtbl.res", + 110, + 19 ], Error: new Error() }; @@ -165,16 +165,16 @@ function resize(indexfun, h) { var ndata_tail = Caml_array.make(nsize, "Empty"); var inplace = h.initial_size >= 0; h.data = ndata; - var insert_bucket = function (_cell) { + var insert_bucket = function (_param) { while(true) { - var cell = _cell; - if (typeof cell !== "object") { + var param = _param; + if (typeof param !== "object") { return ; } - var key = cell.key; - var data = cell.data; - var next = cell.next; - var cell$1 = inplace ? cell : ({ + var key = param.key; + var data = param.data; + var next = param.next; + var cell = inplace ? param : ({ TAG: "Cons", key: key, data: data, @@ -183,12 +183,12 @@ function resize(indexfun, h) { var nidx = Curry._2(indexfun, h, key); var tail = Caml_array.get(ndata_tail, nidx); if (typeof tail !== "object") { - Caml_array.set(ndata, nidx, cell$1); + Caml_array.set(ndata, nidx, cell); } else { - tail.next = cell$1; + tail.next = cell; } - Caml_array.set(ndata_tail, nidx, cell$1); - _cell = next; + Caml_array.set(ndata_tail, nidx, cell); + _param = next; continue ; }; }; @@ -230,15 +230,15 @@ function add(h, key, data) { function remove(h, key) { var i = key_index(h, key); var _prec = "Empty"; - var _c = Caml_array.get(h.data, i); + var _param = Caml_array.get(h.data, i); while(true) { - var c = _c; + var param = _param; var prec = _prec; - if (typeof c !== "object") { + if (typeof param !== "object") { return ; } - var k = c.key; - var next = c.next; + var k = param.key; + var next = param.next; if (Caml_obj.equal(k, key)) { h.size = h.size - 1 | 0; if (typeof prec !== "object") { @@ -248,8 +248,8 @@ function remove(h, key) { return ; } } - _c = next; - _prec = c; + _param = next; + _prec = param; continue ; }; } @@ -383,20 +383,20 @@ function find_all(h, key) { return find_in_bucket(Caml_array.get(h.data, key_index(h, key))); } -function replace_bucket(key, data, _slot) { +function replace_bucket(key, data, _param) { while(true) { - var slot = _slot; - if (typeof slot !== "object") { + var param = _param; + if (typeof param !== "object") { return true; } - var k = slot.key; - var next = slot.next; + var k = param.key; + var next = param.next; if (Caml_obj.equal(k, key)) { - slot.key = key; - slot.data = data; + param.key = key; + param.data = data; return false; } - _slot = next; + _param = next; continue ; }; } @@ -477,11 +477,11 @@ function iter(f, h) { } } -function filter_map_inplace_bucket(f, h, i, _prec, _slot) { +function filter_map_inplace_bucket(f, h, i, _prec, _param) { while(true) { - var slot = _slot; + var param = _param; var prec = _prec; - if (typeof slot !== "object") { + if (typeof param !== "object") { if (typeof prec !== "object") { return Caml_array.set(h.data, i, "Empty"); } else { @@ -489,23 +489,23 @@ function filter_map_inplace_bucket(f, h, i, _prec, _slot) { return ; } } - var key = slot.key; - var data = slot.data; - var next = slot.next; + var key = param.key; + var data = param.data; + var next = param.next; var data$1 = Curry._2(f, key, data); if (data$1 !== undefined) { if (typeof prec !== "object") { - Caml_array.set(h.data, i, slot); + Caml_array.set(h.data, i, param); } else { - prec.next = slot; + prec.next = param; } - slot.data = Caml_option.valFromOption(data$1); - _slot = next; - _prec = slot; + param.data = Caml_option.valFromOption(data$1); + _param = next; + _prec = param; continue ; } h.size = h.size - 1 | 0; - _slot = next; + _param = next; continue ; }; } @@ -624,15 +624,15 @@ function MakeSeeded(H) { var remove = function (h, key) { var i = key_index(h, key); var _prec = "Empty"; - var _c = Caml_array.get(h.data, i); + var _param = Caml_array.get(h.data, i); while(true) { - var c = _c; + var param = _param; var prec = _prec; - if (typeof c !== "object") { + if (typeof param !== "object") { return ; } - var k = c.key; - var next = c.next; + var k = param.key; + var next = param.next; if (Curry._2(H.equal, k, key)) { h.size = h.size - 1 | 0; if (typeof prec !== "object") { @@ -642,8 +642,8 @@ function MakeSeeded(H) { return ; } } - _c = next; - _prec = c; + _param = next; + _prec = param; continue ; }; }; @@ -773,20 +773,20 @@ function MakeSeeded(H) { }; return find_in_bucket(Caml_array.get(h.data, key_index(h, key))); }; - var replace_bucket = function (key, data, _slot) { + var replace_bucket = function (key, data, _param) { while(true) { - var slot = _slot; - if (typeof slot !== "object") { + var param = _param; + if (typeof param !== "object") { return true; } - var k = slot.key; - var next = slot.next; + var k = param.key; + var next = param.next; if (Curry._2(H.equal, k, key)) { - slot.key = key; - slot.data = data; + param.key = key; + param.data = data; return false; } - _slot = next; + _param = next; continue ; }; }; @@ -868,15 +868,15 @@ function Make(H) { var remove = function (h, key) { var i = key_index(h, key); var _prec = "Empty"; - var _c = Caml_array.get(h.data, i); + var _param = Caml_array.get(h.data, i); while(true) { - var c = _c; + var param = _param; var prec = _prec; - if (typeof c !== "object") { + if (typeof param !== "object") { return ; } - var k = c.key; - var next = c.next; + var k = param.key; + var next = param.next; if (Curry._2(equal, k, key)) { h.size = h.size - 1 | 0; if (typeof prec !== "object") { @@ -886,8 +886,8 @@ function Make(H) { return ; } } - _c = next; - _prec = c; + _param = next; + _prec = param; continue ; }; }; @@ -1017,20 +1017,20 @@ function Make(H) { }; return find_in_bucket(Caml_array.get(h.data, key_index(h, key))); }; - var replace_bucket = function (key, data, _slot) { + var replace_bucket = function (key, data, _param) { while(true) { - var slot = _slot; - if (typeof slot !== "object") { + var param = _param; + if (typeof param !== "object") { return true; } - var k = slot.key; - var next = slot.next; + var k = param.key; + var next = param.next; if (Curry._2(equal, k, key)) { - slot.key = key; - slot.data = data; + param.key = key; + param.data = data; return false; } - _slot = next; + _param = next; continue ; }; }; diff --git a/lib/js/list.js b/lib/js/list.js index 1d0b06b099..2a4fa3ef68 100644 --- a/lib/js/list.js +++ b/lib/js/list.js @@ -823,8 +823,8 @@ function chop(_k, _l) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "list.ml", - 262, + "list.res", + 420, 11 ], Error: new Error() diff --git a/lib/js/listLabels.js b/lib/js/listLabels.js index e8955e4878..0633cbadca 100644 --- a/lib/js/listLabels.js +++ b/lib/js/listLabels.js @@ -823,8 +823,8 @@ function chop(_k, _l) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "listLabels.ml", - 262, + "listLabels.res", + 420, 11 ], Error: new Error() diff --git a/lib/js/map.js b/lib/js/map.js index 3ceda28d16..da4f3e632a 100644 --- a/lib/js/map.js +++ b/lib/js/map.js @@ -102,8 +102,8 @@ function Make(funarg) { return false; } }; - var add = function (x, data, m) { - if (typeof m !== "object") { + var add = function (x, data, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -113,14 +113,14 @@ function Make(funarg) { h: 1 }; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { if (d === data) { - return m; + return param; } else { return { TAG: "Node", @@ -128,21 +128,21 @@ function Make(funarg) { v: x, d: data, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = add(x, data, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = add(x, data, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -441,14 +441,14 @@ function Make(funarg) { var match = min_binding(t2); return bal(t1, match[0], match[1], remove_min_binding(t2)); }; - var remove = function (x, m) { - if (typeof m !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { return merge(l, r); @@ -456,20 +456,20 @@ function Make(funarg) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = remove(x, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } }; - var update = function (x, f, m) { - if (typeof m !== "object") { + var update = function (x, f, param) { + if (typeof param !== "object") { var data = Curry._1(f, undefined); if (data !== undefined) { return { @@ -484,10 +484,10 @@ function Make(funarg) { return "Empty"; } } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { var data$1 = Curry._1(f, Caml_option.some(d)); @@ -496,7 +496,7 @@ function Make(funarg) { } var data$2 = Caml_option.valFromOption(data$1); if (d === data$2) { - return m; + return param; } else { return { TAG: "Node", @@ -504,21 +504,21 @@ function Make(funarg) { v: x, d: data$2, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = update(x, f, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = update(x, f, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -713,9 +713,9 @@ function Make(funarg) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "map.ml", - 393, - 10 + "map.res", + 552, + 11 ], Error: new Error() }; @@ -756,20 +756,20 @@ function Make(funarg) { return join(l$1, v2, d2, r$1); } }; - var filter = function (p, m) { - if (typeof m !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pvd = Curry._2(p, v, d); var r$p = filter(p, r); if (pvd) { if (l === l$p && r === r$p) { - return m; + return param; } else { return join(l$p, v, d, r$p); } diff --git a/lib/js/mapLabels.js b/lib/js/mapLabels.js index 79d4163c8f..5ba10c0afe 100644 --- a/lib/js/mapLabels.js +++ b/lib/js/mapLabels.js @@ -102,8 +102,8 @@ function Make(Ord) { return false; } }; - var add = function (x, data, m) { - if (typeof m !== "object") { + var add = function (x, data, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -113,14 +113,14 @@ function Make(Ord) { h: 1 }; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { if (d === data) { - return m; + return param; } else { return { TAG: "Node", @@ -128,21 +128,21 @@ function Make(Ord) { v: x, d: data, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = add(x, data, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = add(x, data, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -441,14 +441,14 @@ function Make(Ord) { var match = min_binding(t2); return bal(t1, match[0], match[1], remove_min_binding(t2)); }; - var remove = function (x, m) { - if (typeof m !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { return merge(l, r); @@ -456,20 +456,20 @@ function Make(Ord) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = remove(x, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } }; - var update = function (x, f, m) { - if (typeof m !== "object") { + var update = function (x, f, param) { + if (typeof param !== "object") { var data = Curry._1(f, undefined); if (data !== undefined) { return { @@ -484,10 +484,10 @@ function Make(Ord) { return "Empty"; } } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { var data$1 = Curry._1(f, Caml_option.some(d)); @@ -496,7 +496,7 @@ function Make(Ord) { } var data$2 = Caml_option.valFromOption(data$1); if (d === data$2) { - return m; + return param; } else { return { TAG: "Node", @@ -504,21 +504,21 @@ function Make(Ord) { v: x, d: data$2, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = update(x, f, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = update(x, f, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -713,9 +713,9 @@ function Make(Ord) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "mapLabels.ml", - 393, - 10 + "mapLabels.res", + 552, + 11 ], Error: new Error() }; @@ -756,20 +756,20 @@ function Make(Ord) { return join(l$1, v2, d2, r$1); } }; - var filter = function (p, m) { - if (typeof m !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pvd = Curry._2(p, v, d); var r$p = filter(p, r); if (pvd) { if (l === l$p && r === r$p) { - return m; + return param; } else { return join(l$p, v, d, r$p); } diff --git a/lib/js/moreLabels.js b/lib/js/moreLabels.js index 46d1a17ee2..c37c95cac2 100644 --- a/lib/js/moreLabels.js +++ b/lib/js/moreLabels.js @@ -132,8 +132,8 @@ var $$Map = { return false; } }; - var add = function (x, data, m) { - if (typeof m !== "object") { + var add = function (x, data, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -143,14 +143,14 @@ var $$Map = { h: 1 }; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { if (d === data) { - return m; + return param; } else { return { TAG: "Node", @@ -158,21 +158,21 @@ var $$Map = { v: x, d: data, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = add(x, data, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = add(x, data, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -471,14 +471,14 @@ var $$Map = { var match = min_binding(t2); return bal(t1, match[0], match[1], remove_min_binding(t2)); }; - var remove = function (x, m) { - if (typeof m !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { return merge(l, r); @@ -486,20 +486,20 @@ var $$Map = { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = remove(x, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } }; - var update = function (x, f, m) { - if (typeof m !== "object") { + var update = function (x, f, param) { + if (typeof param !== "object") { var data = Curry._1(f, undefined); if (data !== undefined) { return { @@ -514,10 +514,10 @@ var $$Map = { return "Empty"; } } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { var data$1 = Curry._1(f, Caml_option.some(d)); @@ -526,7 +526,7 @@ var $$Map = { } var data$2 = Caml_option.valFromOption(data$1); if (d === data$2) { - return m; + return param; } else { return { TAG: "Node", @@ -534,21 +534,21 @@ var $$Map = { v: x, d: data$2, r: r, - h: m.h + h: param.h }; } } if (c < 0) { var ll = update(x, f, l); if (l === ll) { - return m; + return param; } else { return bal(ll, v, d, r); } } var rr = update(x, f, r); if (r === rr) { - return m; + return param; } else { return bal(l, v, d, rr); } @@ -743,9 +743,9 @@ var $$Map = { throw { RE_EXN_ID: "Assert_failure", _1: [ - "mapLabels.ml", - 393, - 10 + "mapLabels.res", + 552, + 11 ], Error: new Error() }; @@ -786,20 +786,20 @@ var $$Map = { return join(l$1, v2, d2, r$1); } }; - var filter = function (p, m) { - if (typeof m !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = m.r; - var d = m.d; - var v = m.v; - var l = m.l; + var r = param.r; + var d = param.d; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pvd = Curry._2(p, v, d); var r$p = filter(p, r); if (pvd) { if (l === l$p && r === r$p) { - return m; + return param; } else { return join(l$p, v, d, r$p); } @@ -1057,8 +1057,8 @@ var $$Set = { Error: new Error() }; }; - var add = function (x, t) { - if (typeof t !== "object") { + var add = function (x, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -1067,24 +1067,24 @@ var $$Set = { h: 1 }; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { - return t; + return param; } if (c < 0) { var ll = add(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = add(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -1279,13 +1279,13 @@ var $$Set = { continue ; }; }; - var remove = function (x, t) { - if (typeof t !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { return merge(l, r); @@ -1293,14 +1293,14 @@ var $$Set = { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = remove(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -1517,19 +1517,19 @@ var $$Set = { continue ; }; }; - var filter = function (p, t) { - if (typeof t !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pv = Curry._1(p, v); var r$p = filter(p, r); if (pv) { if (l === l$p && r === r$p) { - return t; + return param; } else { return join(l$p, v, r$p); } @@ -1759,18 +1759,18 @@ var $$Set = { return union(l, add(v, r)); } }; - var map = function (f, t) { - if (typeof t !== "object") { + var map = function (f, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = map(f, l); var v$p = Curry._1(f, v); var r$p = map(f, r); if (l === l$p && v === v$p && r === r$p) { - return t; + return param; } else { return try_join(l$p, v$p, r$p); } @@ -1871,9 +1871,9 @@ var $$Set = { throw { RE_EXN_ID: "Assert_failure", _1: [ - "setLabels.ml", - 510, - 18 + "setLabels.res", + 691, + 20 ], Error: new Error() }; diff --git a/lib/js/set.js b/lib/js/set.js index 27847c6ad0..4f27c4d77f 100644 --- a/lib/js/set.js +++ b/lib/js/set.js @@ -84,8 +84,8 @@ function Make(funarg) { Error: new Error() }; }; - var add = function (x, t) { - if (typeof t !== "object") { + var add = function (x, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -94,24 +94,24 @@ function Make(funarg) { h: 1 }; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { - return t; + return param; } if (c < 0) { var ll = add(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = add(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -297,13 +297,13 @@ function Make(funarg) { continue ; }; }; - var remove = function (x, t) { - if (typeof t !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(funarg.compare, x, v); if (c === 0) { if (typeof l !== "object") { @@ -317,14 +317,14 @@ function Make(funarg) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = remove(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -540,19 +540,19 @@ function Make(funarg) { continue ; }; }; - var filter = function (p, t) { - if (typeof t !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pv = Curry._1(p, v); var r$p = filter(p, r); if (pv) { if (l === l$p && r === r$p) { - return t; + return param; } else { return join(l$p, v, r$p); } @@ -771,18 +771,18 @@ function Make(funarg) { continue ; }; }; - var map = function (f, t) { - if (typeof t !== "object") { + var map = function (f, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = map(f, l); var v$p = Curry._1(f, v); var r$p = map(f, r); if (l === l$p && v === v$p && r === r$p) { - return t; + return param; } else if ((l$p === "Empty" || Curry._2(funarg.compare, max_elt(l$p), v$p) < 0) && (r$p === "Empty" || Curry._2(funarg.compare, v$p, min_elt(r$p)) < 0)) { return join(l$p, v$p, r$p); } else { @@ -908,9 +908,9 @@ function Make(funarg) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "set.ml", - 510, - 18 + "set.res", + 691, + 20 ], Error: new Error() }; diff --git a/lib/js/setLabels.js b/lib/js/setLabels.js index e7f53c9a7e..e28f5ec6b9 100644 --- a/lib/js/setLabels.js +++ b/lib/js/setLabels.js @@ -84,8 +84,8 @@ function Make(Ord) { Error: new Error() }; }; - var add = function (x, t) { - if (typeof t !== "object") { + var add = function (x, param) { + if (typeof param !== "object") { return { TAG: "Node", l: "Empty", @@ -94,24 +94,24 @@ function Make(Ord) { h: 1 }; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { - return t; + return param; } if (c < 0) { var ll = add(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = add(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -306,13 +306,13 @@ function Make(Ord) { continue ; }; }; - var remove = function (x, t) { - if (typeof t !== "object") { + var remove = function (x, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var c = Curry._2(Ord.compare, x, v); if (c === 0) { return merge(l, r); @@ -320,14 +320,14 @@ function Make(Ord) { if (c < 0) { var ll = remove(x, l); if (l === ll) { - return t; + return param; } else { return bal(ll, v, r); } } var rr = remove(x, r); if (r === rr) { - return t; + return param; } else { return bal(l, v, rr); } @@ -544,19 +544,19 @@ function Make(Ord) { continue ; }; }; - var filter = function (p, t) { - if (typeof t !== "object") { + var filter = function (p, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = filter(p, l); var pv = Curry._1(p, v); var r$p = filter(p, r); if (pv) { if (l === l$p && r === r$p) { - return t; + return param; } else { return join(l$p, v, r$p); } @@ -786,18 +786,18 @@ function Make(Ord) { return union(l, add(v, r)); } }; - var map = function (f, t) { - if (typeof t !== "object") { + var map = function (f, param) { + if (typeof param !== "object") { return "Empty"; } - var r = t.r; - var v = t.v; - var l = t.l; + var r = param.r; + var v = param.v; + var l = param.l; var l$p = map(f, l); var v$p = Curry._1(f, v); var r$p = map(f, r); if (l === l$p && v === v$p && r === r$p) { - return t; + return param; } else { return try_join(l$p, v$p, r$p); } @@ -898,9 +898,9 @@ function Make(Ord) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "setLabels.ml", - 510, - 18 + "setLabels.res", + 691, + 20 ], Error: new Error() }; diff --git a/lib/js/sort.js b/lib/js/sort.js index fb1f0a44cf..d595df2749 100644 --- a/lib/js/sort.js +++ b/lib/js/sort.js @@ -58,30 +58,30 @@ function list(order, l) { tl: initlist(match.tl) }; }; - var merge2 = function (x) { - if (!x) { - return x; + var merge2 = function (param) { + if (!param) { + return param; } - var match = x.tl; + var match = param.tl; if (match) { return { - hd: merge(order, x.hd, match.hd), + hd: merge(order, param.hd, match.hd), tl: merge2(match.tl) }; } else { - return x; + return param; } }; - var _llist = initlist(l); + var _param = initlist(l); while(true) { - var llist = _llist; - if (!llist) { + var param = _param; + if (!param) { return /* [] */0; } - if (!llist.tl) { - return llist.hd; + if (!param.tl) { + return param.hd; } - _llist = merge2(llist); + _param = merge2(param); continue ; }; } diff --git a/lib/js/stream.js b/lib/js/stream.js index 3c564319c9..434ed12774 100644 --- a/lib/js/stream.js +++ b/lib/js/stream.js @@ -58,9 +58,9 @@ function get_data(count, _d) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "stream.ml", - 48, - 12 + "stream.res", + 53, + 13 ], Error: new Error() }; @@ -120,9 +120,9 @@ function peek_data(s) { throw { RE_EXN_ID: "Assert_failure", _1: [ - "stream.ml", - 71, - 12 + "stream.res", + 83, + 13 ], Error: new Error() }; @@ -143,9 +143,9 @@ function peek_data(s) { }; } -function peek(s) { - if (s !== undefined) { - return peek_data(s); +function peek(param) { + if (param !== undefined) { + return peek_data(param); } } @@ -180,9 +180,9 @@ function junk_data(s) { }; } -function junk(data) { - if (data !== undefined) { - return junk_data(data); +function junk(param) { + if (param !== undefined) { + return junk_data(param); } } @@ -220,11 +220,11 @@ function nget_data(n, s) { ]; } -function npeek(n, d) { - if (d !== undefined) { - var match = nget_data(n, d); - d.count = d.count - match[2] | 0; - d.data = match[1]; +function npeek(n, param) { + if (param !== undefined) { + var match = nget_data(n, param); + param.count = param.count - match[2] | 0; + param.data = match[1]; return match[0]; } else { return /* [] */0; From 62012be281a0f0aeb1f89e9ec42c8fa2a49cc787 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Mon, 7 Aug 2023 12:16:58 +0200 Subject: [PATCH 3/9] @ocaml.doc -> @res.doc --- jscomp/stdlib-406/array.resi | 120 ++++++++--------- jscomp/stdlib-406/arrayLabels.resi | 124 ++++++++--------- jscomp/stdlib-406/buffer.resi | 74 +++++----- jscomp/stdlib-406/bytes.resi | 166 +++++++++++------------ jscomp/stdlib-406/bytesLabels.resi | 158 +++++++++++----------- jscomp/stdlib-406/callback.resi | 8 +- jscomp/stdlib-406/char.resi | 36 ++--- jscomp/stdlib-406/complex.resi | 46 +++---- jscomp/stdlib-406/digest.resi | 32 ++--- jscomp/stdlib-406/filename.resi | 64 ++++----- jscomp/stdlib-406/genlex.resi | 8 +- jscomp/stdlib-406/hashtbl.resi | 148 ++++++++++---------- jscomp/stdlib-406/int32.resi | 102 +++++++------- jscomp/stdlib-406/int64.resi | 106 +++++++-------- jscomp/stdlib-406/lazy.resi | 30 ++--- jscomp/stdlib-406/lexing.resi | 52 +++---- jscomp/stdlib-406/list.resi | 200 +++++++++++++-------------- jscomp/stdlib-406/listLabels.resi | 202 ++++++++++++++-------------- jscomp/stdlib-406/map.resi | 150 ++++++++++----------- jscomp/stdlib-406/obj.resi | 4 +- jscomp/stdlib-406/parsing.resi | 32 ++--- jscomp/stdlib-406/queue.resi | 43 +++--- jscomp/stdlib-406/random.resi | 50 +++---- jscomp/stdlib-406/set.resi | 142 +++++++++---------- jscomp/stdlib-406/sort.resi | 12 +- jscomp/stdlib-406/stack.resi | 33 +++-- jscomp/stdlib-406/stream.resi | 50 +++---- jscomp/stdlib-406/string.resi | 124 ++++++++--------- jscomp/stdlib-406/stringLabels.resi | 126 ++++++++--------- jscomp/stdlib-406/sys.resi | 201 ++++++++++++++------------- jscomp/stdlib-406/uchar.resi | 48 +++---- 31 files changed, 1344 insertions(+), 1347 deletions(-) diff --git a/jscomp/stdlib-406/array.resi b/jscomp/stdlib-406/array.resi index d12013f3de..1fff3bbdb3 100644 --- a/jscomp/stdlib-406/array.resi +++ b/jscomp/stdlib-406/array.resi @@ -17,27 +17,27 @@ " Array operations. " ) -@ocaml.doc(" Return the length (number of elements) of the given array. ") +/** Return the length (number of elements) of the given array. */ external length: array<'a> => int = "%array_length" -@ocaml.doc(" [Array.get a n] returns the element number [n] of array [a]. +/** [Array.get a n] returns the element number [n] of array [a]. The first element has number 0. The last element has number [Array.length a - 1]. You can also write [a.(n)] instead of [Array.get a n]. Raise [Invalid_argument \"index out of bounds\"] - if [n] is outside the range 0 to [(Array.length a - 1)]. ") + if [n] is outside the range 0 to [(Array.length a - 1)]. */ external get: (array<'a>, int) => 'a = "%array_safe_get" -@ocaml.doc(" [Array.set a n x] modifies array [a] in place, replacing +/** [Array.set a n x] modifies array [a] in place, replacing element number [n] with [x]. You can also write [a.(n) <- x] instead of [Array.set a n x]. Raise [Invalid_argument \"index out of bounds\"] - if [n] is outside the range 0 to [Array.length a - 1]. ") + if [n] is outside the range 0 to [Array.length a - 1]. */ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" -@ocaml.doc(" [Array.make n x] returns a fresh array of length [n], +/** [Array.make n x] returns a fresh array of length [n], initialized with [x]. All the elements of this new array are initially physically equal to [x] (in the sense of the [==] predicate). @@ -47,33 +47,33 @@ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. If the value of [x] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2].") + size is only [Sys.max_array_length / 2].*/ external make: (int, 'a) => array<'a> = "?make_vect" @ocaml.deprecated("Use Array.make instead.") -@ocaml.doc(" @deprecated [Array.create] is an alias for {!Array.make}. ") +/** @deprecated [Array.create] is an alias for {!Array.make}. */ external create: (int, 'a) => array<'a> = "?make_vect" -@ocaml.doc(" [Array.create_float n] returns a fresh float array of length [n], +/** [Array.create_float n] returns a fresh float array of length [n], with uninitialized data. - @since 4.03 ") + @since 4.03 */ external create_float: int => array = "?make_float_vect" @ocaml.deprecated("Use Array.create_float instead.") -@ocaml.doc(" @deprecated [Array.make_float] is an alias for {!Array.create_float}. ") +/** @deprecated [Array.make_float] is an alias for {!Array.create_float}. */ let make_float: int => array -@ocaml.doc(" [Array.init n f] returns a fresh array of length [n], +/** [Array.init n f] returns a fresh array of length [n], with element number [i] initialized to the result of [f i]. In other terms, [Array.init n f] tabulates the results of [f] applied to the integers [0] to [n-1]. Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. If the return type of [f] is [float], then the maximum - size is only [Sys.max_array_length / 2].") + size is only [Sys.max_array_length / 2].*/ let init: (int, int => 'a) => array<'a> -@ocaml.doc(" [Array.make_matrix dimx dimy e] returns a two-dimensional array +/** [Array.make_matrix dimx dimy e] returns a two-dimensional array (an array of arrays) with first dimension [dimx] and second dimension [dimy]. All the elements of this new matrix are initially physically equal to [e]. @@ -83,41 +83,41 @@ let init: (int, int => 'a) => array<'a> Raise [Invalid_argument] if [dimx] or [dimy] is negative or greater than {!Sys.max_array_length}. If the value of [e] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2]. ") + size is only [Sys.max_array_length / 2]. */ let make_matrix: (int, int, 'a) => array> @ocaml.deprecated("Use Array.make_matrix instead.") -@ocaml.doc(" @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. ") +/** @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. */ let create_matrix: (int, int, 'a) => array> -@ocaml.doc(" [Array.append v1 v2] returns a fresh array containing the - concatenation of the arrays [v1] and [v2]. ") +/** [Array.append v1 v2] returns a fresh array containing the + concatenation of the arrays [v1] and [v2]. */ let append: (array<'a>, array<'a>) => array<'a> -@ocaml.doc(" Same as {!Array.append}, but concatenates a list of arrays. ") +/** Same as {!Array.append}, but concatenates a list of arrays. */ let concat: list> => array<'a> -@ocaml.doc(" [Array.sub a start len] returns a fresh array of length [len], +/** [Array.sub a start len] returns a fresh array of length [len], containing the elements number [start] to [start + len - 1] of array [a]. Raise [Invalid_argument \"Array.sub\"] if [start] and [len] do not designate a valid subarray of [a]; that is, if - [start < 0], or [len < 0], or [start + len > Array.length a]. ") + [start < 0], or [len < 0], or [start + len > Array.length a]. */ let sub: (array<'a>, int, int) => array<'a> -@ocaml.doc(" [Array.copy a] returns a copy of [a], that is, a fresh array - containing the same elements as [a]. ") +/** [Array.copy a] returns a copy of [a], that is, a fresh array + containing the same elements as [a]. */ let copy: array<'a> => array<'a> -@ocaml.doc(" [Array.fill a ofs len x] modifies the array [a] in place, +/** [Array.fill a ofs len x] modifies the array [a] in place, storing [x] in elements number [ofs] to [ofs + len - 1]. Raise [Invalid_argument \"Array.fill\"] if [ofs] and [len] do not - designate a valid subarray of [a]. ") + designate a valid subarray of [a]. */ let fill: (array<'a>, int, int, 'a) => unit -@ocaml.doc(" [Array.blit v1 o1 v2 o2 len] copies [len] elements +/** [Array.blit v1 o1 v2 o2 len] copies [len] elements from array [v1], starting at element number [o1], to array [v2], starting at element number [o2]. It works correctly even if [v1] and [v2] are the same array, and the source and @@ -125,90 +125,90 @@ let fill: (array<'a>, int, int, 'a) => unit Raise [Invalid_argument \"Array.blit\"] if [o1] and [len] do not designate a valid subarray of [v1], or if [o2] and [len] do not - designate a valid subarray of [v2]. ") + designate a valid subarray of [v2]. */ let blit: (array<'a>, int, array<'a>, int, int) => unit -@ocaml.doc(" [Array.to_list a] returns the list of all the elements of [a]. ") +/** [Array.to_list a] returns the list of all the elements of [a]. */ let to_list: array<'a> => list<'a> -@ocaml.doc(" [Array.of_list l] returns a fresh array containing the elements - of [l]. ") +/** [Array.of_list l] returns a fresh array containing the elements + of [l]. */ let of_list: list<'a> => array<'a> @@ocaml.text(" {1 Iterators} ") -@ocaml.doc(" [Array.iter f a] applies function [f] in turn to all +/** [Array.iter f a] applies function [f] in turn to all the elements of [a]. It is equivalent to - [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. ") + [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. */ let iter: ('a => unit, array<'a>) => unit -@ocaml.doc(" Same as {!Array.iter}, but the +/** Same as {!Array.iter}, but the function is applied with the index of the element as first argument, - and the element itself as second argument. ") + and the element itself as second argument. */ let iteri: ((int, 'a) => unit, array<'a>) => unit -@ocaml.doc(" [Array.map f a] applies function [f] to all the elements of [a], +/** [Array.map f a] applies function [f] to all the elements of [a], and builds an array with the results returned by [f]: - [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. ") + [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. */ let map: ('a => 'b, array<'a>) => array<'b> -@ocaml.doc(" Same as {!Array.map}, but the +/** Same as {!Array.map}, but the function is applied to the index of the element as first argument, - and the element itself as second argument. ") + and the element itself as second argument. */ let mapi: ((int, 'a) => 'b, array<'a>) => array<'b> -@ocaml.doc(" [Array.fold_left f x a] computes +/** [Array.fold_left f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], - where [n] is the length of the array [a]. ") + where [n] is the length of the array [a]. */ let fold_left: (('a, 'b) => 'a, 'a, array<'b>) => 'a -@ocaml.doc(" [Array.fold_right f a x] computes +/** [Array.fold_right f a x] computes [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], - where [n] is the length of the array [a]. ") + where [n] is the length of the array [a]. */ let fold_right: (('b, 'a) => 'a, array<'b>, 'a) => 'a @@ocaml.text(" {1 Iterators on two arrays} ") -@ocaml.doc(" [Array.iter2 f a b] applies function [f] to all the elements of [a] +/** [Array.iter2 f a b] applies function [f] to all the elements of [a] and [b]. Raise [Invalid_argument] if the arrays are not the same size. - @since 4.03.0 ") + @since 4.03.0 */ let iter2: (('a, 'b) => unit, array<'a>, array<'b>) => unit -@ocaml.doc(" [Array.map2 f a b] applies function [f] to all the elements of [a] +/** [Array.map2 f a b] applies function [f] to all the elements of [a] and [b], and builds an array with the results returned by [f]: [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. Raise [Invalid_argument] if the arrays are not the same size. - @since 4.03.0 ") + @since 4.03.0 */ let map2: (('a, 'b) => 'c, array<'a>, array<'b>) => array<'c> @@ocaml.text(" {1 Array scanning} ") -@ocaml.doc(" [Array.for_all p [|a1; ...; an|]] checks if all elements of the array +/** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array satisfy the predicate [p]. That is, it returns [(p a1) && (p a2) && ... && (p an)]. - @since 4.03.0 ") + @since 4.03.0 */ let for_all: ('a => bool, array<'a>) => bool -@ocaml.doc(" [Array.exists p [|a1; ...; an|]] checks if at least one element of +/** [Array.exists p [|a1; ...; an|]] checks if at least one element of the array satisfies the predicate [p]. That is, it returns [(p a1) || (p a2) || ... || (p an)]. - @since 4.03.0 ") + @since 4.03.0 */ let exists: ('a => bool, array<'a>) => bool -@ocaml.doc(" [mem a l] is true if and only if [a] is equal +/** [mem a l] is true if and only if [a] is equal to an element of [l]. - @since 4.03.0 ") + @since 4.03.0 */ let mem: ('a, array<'a>) => bool -@ocaml.doc(" Same as {!Array.mem}, but uses physical equality instead of structural +/** Same as {!Array.mem}, but uses physical equality instead of structural equality to compare array elements. - @since 4.03.0 ") + @since 4.03.0 */ let memq: ('a, array<'a>) => bool @@ocaml.text(" {1 Sorting} ") -@ocaml.doc(" Sort an array in increasing order according to a comparison +/** Sort an array in increasing order according to a comparison function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see below for a @@ -231,22 +231,22 @@ let memq: ('a, array<'a>) => bool When [Array.sort] returns, [a] contains the same elements as before, reordered in such a way that for all i and j valid indices of [a] : - [cmp a.(i) a.(j)] >= 0 if and only if i >= j -") +*/ let sort: (('a, 'a) => int, array<'a>) => unit -@ocaml.doc(" Same as {!Array.sort}, but the sorting algorithm is stable (i.e. +/** Same as {!Array.sort}, but the sorting algorithm is stable (i.e. elements that compare equal are kept in their original order) and not guaranteed to run in constant heap space. The current implementation uses Merge Sort. It uses [n/2] words of heap space, where [n] is the length of the array. It is usually faster than the current implementation of {!Array.sort}. -") +*/ let stable_sort: (('a, 'a) => int, array<'a>) => unit -@ocaml.doc(" Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster +/** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster on typical input. -") +*/ let fast_sort: (('a, 'a) => int, array<'a>) => unit @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/arrayLabels.resi b/jscomp/stdlib-406/arrayLabels.resi index db4fa2cd4f..9f6b5a4ae3 100644 --- a/jscomp/stdlib-406/arrayLabels.resi +++ b/jscomp/stdlib-406/arrayLabels.resi @@ -17,27 +17,27 @@ " Array operations. " ) -@ocaml.doc(" Return the length (number of elements) of the given array. ") +/** Return the length (number of elements) of the given array. */ external length: array<'a> => int = "%array_length" -@ocaml.doc(" [Array.get a n] returns the element number [n] of array [a]. +/** [Array.get a n] returns the element number [n] of array [a]. The first element has number 0. The last element has number [Array.length a - 1]. You can also write [a.(n)] instead of [Array.get a n]. Raise [Invalid_argument \"index out of bounds\"] - if [n] is outside the range 0 to [(Array.length a - 1)]. ") + if [n] is outside the range 0 to [(Array.length a - 1)]. */ external get: (array<'a>, int) => 'a = "%array_safe_get" -@ocaml.doc(" [Array.set a n x] modifies array [a] in place, replacing +/** [Array.set a n x] modifies array [a] in place, replacing element number [n] with [x]. You can also write [a.(n) <- x] instead of [Array.set a n x]. Raise [Invalid_argument \"index out of bounds\"] - if [n] is outside the range 0 to [Array.length a - 1]. ") + if [n] is outside the range 0 to [Array.length a - 1]. */ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" -@ocaml.doc(" [Array.make n x] returns a fresh array of length [n], +/** [Array.make n x] returns a fresh array of length [n], initialized with [x]. All the elements of this new array are initially physically equal to [x] (in the sense of the [==] predicate). @@ -47,24 +47,24 @@ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. If the value of [x] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2].") + size is only [Sys.max_array_length / 2].*/ external make: (int, 'a) => array<'a> = "?make_vect" @ocaml.deprecated("Use Array.make instead.") -@ocaml.doc(" @deprecated [Array.create] is an alias for {!Array.make}. ") +/** @deprecated [Array.create] is an alias for {!Array.make}. */ external create: (int, 'a) => array<'a> = "?make_vect" -@ocaml.doc(" [Array.init n f] returns a fresh array of length [n], +/** [Array.init n f] returns a fresh array of length [n], with element number [i] initialized to the result of [f i]. In other terms, [Array.init n f] tabulates the results of [f] applied to the integers [0] to [n-1]. Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. If the return type of [f] is [float], then the maximum - size is only [Sys.max_array_length / 2].") + size is only [Sys.max_array_length / 2].*/ let init: (int, ~f: int => 'a) => array<'a> -@ocaml.doc(" [Array.make_matrix dimx dimy e] returns a two-dimensional array +/** [Array.make_matrix dimx dimy e] returns a two-dimensional array (an array of arrays) with first dimension [dimx] and second dimension [dimy]. All the elements of this new matrix are initially physically equal to [e]. @@ -74,42 +74,42 @@ let init: (int, ~f: int => 'a) => array<'a> Raise [Invalid_argument] if [dimx] or [dimy] is negative or greater than {!Sys.max_array_length}. If the value of [e] is a floating-point number, then the maximum - size is only [Sys.max_array_length / 2]. ") + size is only [Sys.max_array_length / 2]. */ let make_matrix: (~dimx: int, ~dimy: int, 'a) => array> @ocaml.deprecated("Use Array.make_matrix instead.") -@ocaml.doc(" @deprecated [Array.create_matrix] is an alias for - {!Array.make_matrix}. ") +/** @deprecated [Array.create_matrix] is an alias for + {!Array.make_matrix}. */ let create_matrix: (~dimx: int, ~dimy: int, 'a) => array> -@ocaml.doc(" [Array.append v1 v2] returns a fresh array containing the - concatenation of the arrays [v1] and [v2]. ") +/** [Array.append v1 v2] returns a fresh array containing the + concatenation of the arrays [v1] and [v2]. */ let append: (array<'a>, array<'a>) => array<'a> -@ocaml.doc(" Same as {!Array.append}, but concatenates a list of arrays. ") +/** Same as {!Array.append}, but concatenates a list of arrays. */ let concat: list> => array<'a> -@ocaml.doc(" [Array.sub a start len] returns a fresh array of length [len], +/** [Array.sub a start len] returns a fresh array of length [len], containing the elements number [start] to [start + len - 1] of array [a]. Raise [Invalid_argument \"Array.sub\"] if [start] and [len] do not designate a valid subarray of [a]; that is, if - [start < 0], or [len < 0], or [start + len > Array.length a]. ") + [start < 0], or [len < 0], or [start + len > Array.length a]. */ let sub: (array<'a>, ~pos: int, ~len: int) => array<'a> -@ocaml.doc(" [Array.copy a] returns a copy of [a], that is, a fresh array - containing the same elements as [a]. ") +/** [Array.copy a] returns a copy of [a], that is, a fresh array + containing the same elements as [a]. */ let copy: array<'a> => array<'a> -@ocaml.doc(" [Array.fill a ofs len x] modifies the array [a] in place, +/** [Array.fill a ofs len x] modifies the array [a] in place, storing [x] in elements number [ofs] to [ofs + len - 1]. Raise [Invalid_argument \"Array.fill\"] if [ofs] and [len] do not - designate a valid subarray of [a]. ") + designate a valid subarray of [a]. */ let fill: (array<'a>, ~pos: int, ~len: int, 'a) => unit -@ocaml.doc(" [Array.blit v1 o1 v2 o2 len] copies [len] elements +/** [Array.blit v1 o1 v2 o2 len] copies [len] elements from array [v1], starting at element number [o1], to array [v2], starting at element number [o2]. It works correctly even if [v1] and [v2] are the same array, and the source and @@ -117,98 +117,98 @@ let fill: (array<'a>, ~pos: int, ~len: int, 'a) => unit Raise [Invalid_argument \"Array.blit\"] if [o1] and [len] do not designate a valid subarray of [v1], or if [o2] and [len] do not - designate a valid subarray of [v2]. ") + designate a valid subarray of [v2]. */ let blit: (~src: array<'a>, ~src_pos: int, ~dst: array<'a>, ~dst_pos: int, ~len: int) => unit -@ocaml.doc(" [Array.to_list a] returns the list of all the elements of [a]. ") +/** [Array.to_list a] returns the list of all the elements of [a]. */ let to_list: array<'a> => list<'a> -@ocaml.doc(" [Array.of_list l] returns a fresh array containing the elements - of [l]. ") +/** [Array.of_list l] returns a fresh array containing the elements + of [l]. */ let of_list: list<'a> => array<'a> -@ocaml.doc(" [Array.iter f a] applies function [f] in turn to all +/** [Array.iter f a] applies function [f] in turn to all the elements of [a]. It is equivalent to - [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. ") + [f a.(0); f a.(1); ...; f a.(Array.length a - 1); ()]. */ let iter: (~f: 'a => unit, array<'a>) => unit -@ocaml.doc(" [Array.map f a] applies function [f] to all the elements of [a], +/** [Array.map f a] applies function [f] to all the elements of [a], and builds an array with the results returned by [f]: - [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. ") + [[| f a.(0); f a.(1); ...; f a.(Array.length a - 1) |]]. */ let map: (~f: 'a => 'b, array<'a>) => array<'b> -@ocaml.doc(" Same as {!Array.iter}, but the +/** Same as {!Array.iter}, but the function is applied to the index of the element as first argument, - and the element itself as second argument. ") + and the element itself as second argument. */ let iteri: (~f: (int, 'a) => unit, array<'a>) => unit -@ocaml.doc(" Same as {!Array.map}, but the +/** Same as {!Array.map}, but the function is applied to the index of the element as first argument, - and the element itself as second argument. ") + and the element itself as second argument. */ let mapi: (~f: (int, 'a) => 'b, array<'a>) => array<'b> -@ocaml.doc(" [Array.fold_left f x a] computes +/** [Array.fold_left f x a] computes [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)], - where [n] is the length of the array [a]. ") + where [n] is the length of the array [a]. */ let fold_left: (~f: ('a, 'b) => 'a, ~init: 'a, array<'b>) => 'a -@ocaml.doc(" [Array.fold_right f a x] computes +/** [Array.fold_right f a x] computes [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))], - where [n] is the length of the array [a]. ") + where [n] is the length of the array [a]. */ let fold_right: (~f: ('b, 'a) => 'a, array<'b>, ~init: 'a) => 'a @@ocaml.text(" {6 Iterators on two arrays} ") -@ocaml.doc(" [Array.iter2 f a b] applies function [f] to all the elements of [a] +/** [Array.iter2 f a b] applies function [f] to all the elements of [a] and [b]. Raise [Invalid_argument] if the arrays are not the same size. - @since 4.05.0 ") + @since 4.05.0 */ let iter2: (~f: ('a, 'b) => unit, array<'a>, array<'b>) => unit -@ocaml.doc(" [Array.map2 f a b] applies function [f] to all the elements of [a] +/** [Array.map2 f a b] applies function [f] to all the elements of [a] and [b], and builds an array with the results returned by [f]: [[| f a.(0) b.(0); ...; f a.(Array.length a - 1) b.(Array.length b - 1)|]]. Raise [Invalid_argument] if the arrays are not the same size. - @since 4.05.0 ") + @since 4.05.0 */ let map2: (~f: ('a, 'b) => 'c, array<'a>, array<'b>) => array<'c> @@ocaml.text(" {6 Array scanning} ") -@ocaml.doc(" [Array.exists p [|a1; ...; an|]] checks if at least one element of +/** [Array.exists p [|a1; ...; an|]] checks if at least one element of the array satisfies the predicate [p]. That is, it returns [(p a1) || (p a2) || ... || (p an)]. - @since 4.03.0 ") + @since 4.03.0 */ let exists: (~f: 'a => bool, array<'a>) => bool -@ocaml.doc(" [Array.for_all p [|a1; ...; an|]] checks if all elements of the array +/** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array satisfy the predicate [p]. That is, it returns [(p a1) && (p a2) && ... && (p an)]. - @since 4.03.0 ") + @since 4.03.0 */ let for_all: (~f: 'a => bool, array<'a>) => bool -@ocaml.doc(" [mem x a] is true if and only if [x] is equal +/** [mem x a] is true if and only if [x] is equal to an element of [a]. - @since 4.03.0 ") + @since 4.03.0 */ let mem: ('a, ~set: array<'a>) => bool -@ocaml.doc(" Same as {!Array.mem}, but uses physical equality instead of structural +/** Same as {!Array.mem}, but uses physical equality instead of structural equality to compare list elements. - @since 4.03.0 ") + @since 4.03.0 */ let memq: ('a, ~set: array<'a>) => bool -@ocaml.doc(" [Array.create_float n] returns a fresh float array of length [n], +/** [Array.create_float n] returns a fresh float array of length [n], with uninitialized data. - @since 4.03 ") + @since 4.03 */ external create_float: int => array = "?make_float_vect" @ocaml.deprecated("Use Array.create_float instead.") -@ocaml.doc(" @deprecated [Array.make_float] is an alias for - {!Array.create_float}. ") +/** @deprecated [Array.make_float] is an alias for + {!Array.create_float}. */ let make_float: int => array @@ocaml.text(" {1 Sorting} ") -@ocaml.doc(" Sort an array in increasing order according to a comparison +/** Sort an array in increasing order according to a comparison function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see below for a @@ -231,22 +231,22 @@ let make_float: int => array When [Array.sort] returns, [a] contains the same elements as before, reordered in such a way that for all i and j valid indices of [a] : - [cmp a.(i) a.(j)] >= 0 if and only if i >= j -") +*/ let sort: (~cmp: ('a, 'a) => int, array<'a>) => unit -@ocaml.doc(" Same as {!Array.sort}, but the sorting algorithm is stable (i.e. +/** Same as {!Array.sort}, but the sorting algorithm is stable (i.e. elements that compare equal are kept in their original order) and not guaranteed to run in constant heap space. The current implementation uses Merge Sort. It uses [n/2] words of heap space, where [n] is the length of the array. It is usually faster than the current implementation of {!Array.sort}. -") +*/ let stable_sort: (~cmp: ('a, 'a) => int, array<'a>) => unit -@ocaml.doc(" Same as {!Array.sort} or {!Array.stable_sort}, whichever is +/** Same as {!Array.sort} or {!Array.stable_sort}, whichever is faster on typical input. -") +*/ let fast_sort: (~cmp: ('a, 'a) => int, array<'a>) => unit @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/buffer.resi b/jscomp/stdlib-406/buffer.resi index 3fe7fdc793..228731ae51 100644 --- a/jscomp/stdlib-406/buffer.resi +++ b/jscomp/stdlib-406/buffer.resi @@ -21,10 +21,10 @@ concatenated pairwise). ") -@ocaml.doc(" The abstract type of buffers. ") +/** The abstract type of buffers. */ type t -@ocaml.doc(" [create n] returns a fresh buffer, initially empty. +/** [create n] returns a fresh buffer, initially empty. The [n] parameter is the initial size of the internal byte sequence that holds the buffer contents. That byte sequence is automatically reallocated when more than [n] characters are stored in the buffer, @@ -35,26 +35,26 @@ type t line). Nothing bad will happen if the buffer grows beyond that limit, however. In doubt, take [n = 16] for instance. If [n] is not between 1 and {!Sys.max_string_length}, it will - be clipped to that interval. ") + be clipped to that interval. */ let create: int => t -@ocaml.doc(" Return a copy of the current contents of the buffer. - The buffer itself is unchanged. ") +/** Return a copy of the current contents of the buffer. + The buffer itself is unchanged. */ let contents: t => string -@ocaml.doc(" Return a copy of the current contents of the buffer. +/** Return a copy of the current contents of the buffer. The buffer itself is unchanged. - @since 4.02 ") + @since 4.02 */ let to_bytes: t => bytes -@ocaml.doc(" [Buffer.sub b off len] returns a copy of [len] bytes from the +/** [Buffer.sub b off len] returns a copy of [len] bytes from the current contents of the buffer [b], starting at offset [off]. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid - range of [b]. ") + range of [b]. */ let sub: (t, int, int) => string -@ocaml.doc(" [Buffer.blit src srcoff dst dstoff len] copies [len] characters from +/** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from the current contents of the buffer [src], starting at offset [srcoff] to [dst], starting at character [dstoff]. @@ -62,66 +62,66 @@ let sub: (t, int, int) => string range of [src], or if [dstoff] and [len] do not designate a valid range of [dst]. @since 3.11.2 -") +*/ let blit: (t, int, bytes, int, int) => unit -@ocaml.doc(" Get the n-th character of the buffer. Raise [Invalid_argument] if - index out of bounds ") +/** Get the n-th character of the buffer. Raise [Invalid_argument] if + index out of bounds */ let nth: (t, int) => char -@ocaml.doc(" Return the number of characters currently contained in the buffer. ") +/** Return the number of characters currently contained in the buffer. */ let length: t => int -@ocaml.doc(" Empty the buffer. ") +/** Empty the buffer. */ let clear: t => unit -@ocaml.doc(" Empty the buffer and deallocate the internal byte sequence holding the +/** Empty the buffer and deallocate the internal byte sequence holding the buffer contents, replacing it with the initial internal byte sequence of length [n] that was allocated by {!Buffer.create} [n]. For long-lived buffers that may have grown a lot, [reset] allows - faster reclamation of the space used by the buffer. ") + faster reclamation of the space used by the buffer. */ let reset: t => unit -@ocaml.doc(" [add_char b c] appends the character [c] at the end of buffer [b]. ") +/** [add_char b c] appends the character [c] at the end of buffer [b]. */ let add_char: (t, char) => unit -@ocaml.doc(" [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629} +/** [add_utf_8_uchar b u] appends the {{:https://tools.ietf.org/html/rfc3629} UTF-8} encoding of [u] at the end of buffer [b]. - @since 4.06.0 ") + @since 4.06.0 */ let add_utf_8_uchar: (t, Uchar.t) => unit -@ocaml.doc(" [add_utf_16le_uchar b u] appends the +/** [add_utf_16le_uchar b u] appends the {{:https://tools.ietf.org/html/rfc2781}UTF-16LE} encoding of [u] at the end of buffer [b]. - @since 4.06.0 ") + @since 4.06.0 */ let add_utf_16le_uchar: (t, Uchar.t) => unit -@ocaml.doc(" [add_utf_16be_uchar b u] appends the +/** [add_utf_16be_uchar b u] appends the {{:https://tools.ietf.org/html/rfc2781}UTF-16BE} encoding of [u] at the end of buffer [b]. - @since 4.06.0 ") + @since 4.06.0 */ let add_utf_16be_uchar: (t, Uchar.t) => unit -@ocaml.doc(" [add_string b s] appends the string [s] at the end of buffer [b]. ") +/** [add_string b s] appends the string [s] at the end of buffer [b]. */ let add_string: (t, string) => unit -@ocaml.doc(" [add_bytes b s] appends the byte sequence [s] at the end of buffer [b]. - @since 4.02 ") +/** [add_bytes b s] appends the byte sequence [s] at the end of buffer [b]. + @since 4.02 */ let add_bytes: (t, bytes) => unit -@ocaml.doc(" [add_substring b s ofs len] takes [len] characters from offset - [ofs] in string [s] and appends them at the end of buffer [b]. ") +/** [add_substring b s ofs len] takes [len] characters from offset + [ofs] in string [s] and appends them at the end of buffer [b]. */ let add_substring: (t, string, int, int) => unit -@ocaml.doc(" [add_subbytes b s ofs len] takes [len] characters from offset +/** [add_subbytes b s ofs len] takes [len] characters from offset [ofs] in byte sequence [s] and appends them at the end of buffer [b]. - @since 4.02 ") + @since 4.02 */ let add_subbytes: (t, bytes, int, int) => unit -@ocaml.doc(" [add_substitute b f s] appends the string pattern [s] at the end +/** [add_substitute b f s] appends the string pattern [s] at the end of buffer [b] with substitution. The substitution process looks for variables into the pattern and substitutes each variable name by its value, as @@ -134,15 +134,15 @@ let add_subbytes: (t, bytes, int, int) => unit An escaped [$] character is a [$] that immediately follows a backslash character; it then stands for a plain [$]. Raise [Not_found] if the closing character of a parenthesized variable - cannot be found. ") + cannot be found. */ let add_substitute: (t, string => string, string) => unit -@ocaml.doc(" [add_buffer b1 b2] appends the current contents of buffer [b2] - at the end of buffer [b1]. [b2] is not modified. ") +/** [add_buffer b1 b2] appends the current contents of buffer [b2] + at the end of buffer [b1]. [b2] is not modified. */ let add_buffer: (t, t) => unit -@ocaml.doc(" [truncate b len] truncates the length of [b] to [len] +/** [truncate b len] truncates the length of [b] to [len] Note: the internal byte sequence is not shortened. Raise [Invalid_argument] if [len < 0] or [len > length b]. - @since 4.05.0 ") + @since 4.05.0 */ let truncate: (t, int) => unit diff --git a/jscomp/stdlib-406/bytes.resi b/jscomp/stdlib-406/bytes.resi index 7c99314386..81ceaf12f3 100644 --- a/jscomp/stdlib-406/bytes.resi +++ b/jscomp/stdlib-406/bytes.resi @@ -42,83 +42,83 @@ @since 4.02.0 ") -@ocaml.doc(" Return the length (number of bytes) of the argument. ") +/** Return the length (number of bytes) of the argument. */ external length: bytes => int = "%bytes_length" -@ocaml.doc(" [get s n] returns the byte at index [n] in argument [s]. +/** [get s n] returns the byte at index [n] in argument [s]. - Raise [Invalid_argument] if [n] is not a valid index in [s]. ") + Raise [Invalid_argument] if [n] is not a valid index in [s]. */ external get: (bytes, int) => char = "%bytes_safe_get" -@ocaml.doc(" [set s n c] modifies [s] in place, replacing the byte at index [n] +/** [set s n c] modifies [s] in place, replacing the byte at index [n] with [c]. - Raise [Invalid_argument] if [n] is not a valid index in [s]. ") + Raise [Invalid_argument] if [n] is not a valid index in [s]. */ external set: (bytes, int, char) => unit = "%bytes_safe_set" -@ocaml.doc(" [create n] returns a new byte sequence of length [n]. The +/** [create n] returns a new byte sequence of length [n]. The sequence is uninitialized and contains arbitrary bytes. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ external create: int => bytes = "?create_bytes" -@ocaml.doc(" [make n c] returns a new byte sequence of length [n], filled with +/** [make n c] returns a new byte sequence of length [n], filled with the byte [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ let make: (int, char) => bytes -@ocaml.doc(" [Bytes.init n f] returns a fresh byte sequence of length [n], with +/** [Bytes.init n f] returns a fresh byte sequence of length [n], with character [i] initialized to the result of [f i] (in increasing index order). - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ let init: (int, int => char) => bytes -@ocaml.doc(" A byte sequence of size 0. ") +/** A byte sequence of size 0. */ let empty: bytes -@ocaml.doc(" Return a new byte sequence that contains the same bytes as the - argument. ") +/** Return a new byte sequence that contains the same bytes as the + argument. */ let copy: bytes => bytes -@ocaml.doc(" Return a new byte sequence that contains the same bytes as the - given string. ") +/** Return a new byte sequence that contains the same bytes as the + given string. */ let of_string: string => bytes -@ocaml.doc(" Return a new string that contains the same bytes as the given byte - sequence. ") +/** Return a new string that contains the same bytes as the given byte + sequence. */ let to_string: bytes => string -@ocaml.doc(" [sub s start len] returns a new byte sequence of length [len], +/** [sub s start len] returns a new byte sequence of length [len], containing the subsequence of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. ") + valid range of [s]. */ let sub: (bytes, int, int) => bytes -@ocaml.doc(" Same as [sub] but return a string instead of a byte sequence. ") +/** Same as [sub] but return a string instead of a byte sequence. */ let sub_string: (bytes, int, int) => string -@ocaml.doc(" [extend s left right] returns a new byte sequence that contains +/** [extend s left right] returns a new byte sequence that contains the bytes of [s], with [left] uninitialized bytes prepended and [right] uninitialized bytes appended to it. If [left] or [right] is negative, then bytes are removed (instead of appended) from the corresponding side of [s]. Raise [Invalid_argument] if the result length is negative or - longer than {!Sys.max_string_length} bytes. ") + longer than {!Sys.max_string_length} bytes. */ let extend: (bytes, int, int) => bytes -@ocaml.doc(" [fill s start len c] modifies [s] in place, replacing [len] +/** [fill s start len c] modifies [s] in place, replacing [len] characters with [c], starting at [start]. Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. ") + valid range of [s]. */ let fill: (bytes, int, int, char) => unit -@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from sequence +/** [blit src srcoff dst dstoff len] copies [len] bytes from sequence [src], starting at index [srcoff], to sequence [dst], starting at index [dstoff]. It works correctly even if [src] and [dst] are the same byte sequence, and the source and destination intervals @@ -126,170 +126,170 @@ let fill: (bytes, int, int, char) => unit Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. ") + do not designate a valid range of [dst]. */ let blit: (bytes, int, bytes, int, int) => unit -@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from string +/** [blit src srcoff dst dstoff len] copies [len] bytes from string [src], starting at index [srcoff], to byte sequence [dst], starting at index [dstoff]. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. ") + do not designate a valid range of [dst]. */ let blit_string: (string, int, bytes, int, int) => unit -@ocaml.doc(" [concat sep sl] concatenates the list of byte sequences [sl], +/** [concat sep sl] concatenates the list of byte sequences [sl], inserting the separator byte sequence [sep] between each, and returns the result as a new byte sequence. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. ") + {!Sys.max_string_length} bytes. */ let concat: (bytes, list) => bytes -@ocaml.doc(" [cat s1 s2] concatenates [s1] and [s2] and returns the result +/** [cat s1 s2] concatenates [s1] and [s2] and returns the result as new byte sequence. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. ") + {!Sys.max_string_length} bytes. */ let cat: (bytes, bytes) => bytes -@ocaml.doc(" [iter f s] applies function [f] in turn to all the bytes of [s]. +/** [iter f s] applies function [f] in turn to all the bytes of [s]. It is equivalent to [f (get s 0); f (get s 1); ...; f (get s - (length s - 1)); ()]. ") + (length s - 1)); ()]. */ let iter: (char => unit, bytes) => unit -@ocaml.doc(" Same as {!Bytes.iter}, but the function is applied to the index of +/** Same as {!Bytes.iter}, but the function is applied to the index of the byte as first argument and the byte itself as second - argument. ") + argument. */ let iteri: ((int, char) => unit, bytes) => unit -@ocaml.doc(" [map f s] applies function [f] in turn to all the bytes of [s] +/** [map f s] applies function [f] in turn to all the bytes of [s] (in increasing index order) and stores the resulting bytes in - a new sequence that is returned as the result. ") + a new sequence that is returned as the result. */ let map: (char => char, bytes) => bytes -@ocaml.doc(" [mapi f s] calls [f] with each character of [s] and its +/** [mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the resulting bytes - in a new sequence that is returned as the result. ") + in a new sequence that is returned as the result. */ let mapi: ((int, char) => char, bytes) => bytes -@ocaml.doc(" Return a copy of the argument, without leading and trailing +/** Return a copy of the argument, without leading and trailing whitespace. The bytes regarded as whitespace are the ASCII - characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. ") + characters [' '], ['\x0c'], ['\n'], ['\r'], and ['\t']. */ let trim: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with special characters represented +/** Return a copy of the argument, with special characters represented by escape sequences, following the lexical conventions of OCaml. All characters outside the ASCII printable range (32..126) are escaped, as well as backslash and double-quote. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. ") + {!Sys.max_string_length} bytes. */ let escaped: bytes => bytes -@ocaml.doc(" [index s c] returns the index of the first occurrence of byte [c] +/** [index s c] returns the index of the first occurrence of byte [c] in [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let index: (bytes, char) => int -@ocaml.doc(" [index_opt s c] returns the index of the first occurrence of byte [c] +/** [index_opt s c] returns the index of the first occurrence of byte [c] in [s] or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let index_opt: (bytes, char) => option -@ocaml.doc(" [rindex s c] returns the index of the last occurrence of byte [c] +/** [rindex s c] returns the index of the last occurrence of byte [c] in [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let rindex: (bytes, char) => int -@ocaml.doc(" [rindex_opt s c] returns the index of the last occurrence of byte [c] +/** [rindex_opt s c] returns the index of the last occurrence of byte [c] in [s] or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let rindex_opt: (bytes, char) => option -@ocaml.doc(" [index_from s i c] returns the index of the first occurrence of +/** [index_from s i c] returns the index of the first occurrence of byte [c] in [s] after position [i]. [Bytes.index s c] is equivalent to [Bytes.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. ") + Raise [Not_found] if [c] does not occur in [s] after position [i]. */ let index_from: (bytes, int, char) => int -@ocaml.doc(" [index_from _opts i c] returns the index of the first occurrence of +/** [index_from _opts i c] returns the index of the first occurrence of byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - @since 4.05 ") + @since 4.05 */ let index_from_opt: (bytes, int, char) => option -@ocaml.doc(" [rindex_from s i c] returns the index of the last occurrence of +/** [rindex_from s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1]. [rindex s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. */ let rindex_from: (bytes, int, char) => int -@ocaml.doc(" [rindex_from_opt s i c] returns the index of the last occurrence +/** [rindex_from_opt s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1] or [None] if [c] does not occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - @since 4.05 ") + @since 4.05 */ let rindex_from_opt: (bytes, int, char) => option -@ocaml.doc(" [contains s c] tests if byte [c] appears in [s]. ") +/** [contains s c] tests if byte [c] appears in [s]. */ let contains: (bytes, char) => bool -@ocaml.doc(" [contains_from s start c] tests if byte [c] appears in [s] after +/** [contains_from s start c] tests if byte [c] appears in [s] after position [start]. [contains s c] is equivalent to [contains_from s 0 c]. - Raise [Invalid_argument] if [start] is not a valid position in [s]. ") + Raise [Invalid_argument] if [start] is not a valid position in [s]. */ let contains_from: (bytes, int, char) => bool -@ocaml.doc(" [rcontains_from s stop c] tests if byte [c] appears in [s] before +/** [rcontains_from s stop c] tests if byte [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. ") + position in [s]. */ let rcontains_from: (bytes, int, char) => bool -@ocaml.doc(" Return a copy of the argument, with all lowercase letters +/** Return a copy of the argument, with all lowercase letters translated to uppercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let uppercase_ascii: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with all uppercase letters +/** Return a copy of the argument, with all uppercase letters translated to lowercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let lowercase_ascii: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, +/** Return a copy of the argument, with the first character set to uppercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let capitalize_ascii: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, +/** Return a copy of the argument, with the first character set to lowercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let uncapitalize_ascii: bytes => bytes -@ocaml.doc(" An alias for the type of byte sequences. ") +/** An alias for the type of byte sequences. */ type t = bytes -@ocaml.doc(" The comparison function for byte sequences, with the same +/** The comparison function for byte sequences, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Bytes] to be passed as - argument to the functors {!Set.Make} and {!Map.Make}. ") + argument to the functors {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equality function for byte sequences. - @since 4.03.0 ") +/** The equality function for byte sequences. + @since 4.03.0 */ let equal: (t, t) => bool @@ocaml.text(" {3 Unsafe conversions (for advanced users)} @@ -302,7 +302,7 @@ let equal: (t, t) => bool always-correct {!Bytes.to_string} and {!Bytes.of_string} instead. ") -@ocaml.doc(" Unsafely convert a byte sequence into a string. +/** Unsafely convert a byte sequence into a string. To reason about the use of [unsafe_to_string], it is convenient to consider an \"ownership\" discipline. A piece of code that @@ -375,10 +375,10 @@ let bytes_length (s : bytes) = but also higher-order functions: if {!String.length} returned a closure to be called later, [s] should not be mutated until this closure is fully applied and returns ownership. -") +*/ let unsafe_to_string: bytes => string -@ocaml.doc(" Unsafely convert a shared string to a byte sequence that should +/** Unsafely convert a shared string to a byte sequence that should not be mutated. The same ownership discipline that makes [unsafe_to_string] @@ -418,7 +418,7 @@ let s = Bytes.of_string \"hello\" low-level programs that manipulate immutable sequences of bytes (for example {!Marshal.from_bytes}) and previously used the [string] type for this purpose. -") +*/ let unsafe_of_string: string => bytes @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/bytesLabels.resi b/jscomp/stdlib-406/bytesLabels.resi index e519535284..40af0415a4 100644 --- a/jscomp/stdlib-406/bytesLabels.resi +++ b/jscomp/stdlib-406/bytesLabels.resi @@ -17,65 +17,65 @@ @since 4.02.0 ") -@ocaml.doc(" Return the length (number of bytes) of the argument. ") +/** Return the length (number of bytes) of the argument. */ external length: bytes => int = "%bytes_length" -@ocaml.doc(" [get s n] returns the byte at index [n] in argument [s]. +/** [get s n] returns the byte at index [n] in argument [s]. - Raise [Invalid_argument] if [n] is not a valid index in [s]. ") + Raise [Invalid_argument] if [n] is not a valid index in [s]. */ external get: (bytes, int) => char = "%bytes_safe_get" -@ocaml.doc(" [set s n c] modifies [s] in place, replacing the byte at index [n] +/** [set s n c] modifies [s] in place, replacing the byte at index [n] with [c]. - Raise [Invalid_argument] if [n] is not a valid index in [s]. ") + Raise [Invalid_argument] if [n] is not a valid index in [s]. */ external set: (bytes, int, char) => unit = "%bytes_safe_set" -@ocaml.doc(" [create n] returns a new byte sequence of length [n]. The +/** [create n] returns a new byte sequence of length [n]. The sequence is uninitialized and contains arbitrary bytes. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ external create: int => bytes = "?create_bytes" -@ocaml.doc(" [make n c] returns a new byte sequence of length [n], filled with +/** [make n c] returns a new byte sequence of length [n], filled with the byte [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ let make: (int, char) => bytes -@ocaml.doc(" [init n f] returns a fresh byte sequence of length [n], +/** [init n f] returns a fresh byte sequence of length [n], with character [i] initialized to the result of [f i]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ let init: (int, ~f: int => char) => bytes -@ocaml.doc(" A byte sequence of size 0. ") +/** A byte sequence of size 0. */ let empty: bytes -@ocaml.doc(" Return a new byte sequence that contains the same bytes as the - argument. ") +/** Return a new byte sequence that contains the same bytes as the + argument. */ let copy: bytes => bytes -@ocaml.doc(" Return a new byte sequence that contains the same bytes as the - given string. ") +/** Return a new byte sequence that contains the same bytes as the + given string. */ let of_string: string => bytes -@ocaml.doc(" Return a new string that contains the same bytes as the given byte - sequence. ") +/** Return a new string that contains the same bytes as the given byte + sequence. */ let to_string: bytes => string -@ocaml.doc(" [sub s start len] returns a new byte sequence of length [len], +/** [sub s start len] returns a new byte sequence of length [len], containing the subsequence of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. ") + valid range of [s]. */ let sub: (bytes, ~pos: int, ~len: int) => bytes -@ocaml.doc(" Same as [sub] but return a string instead of a byte sequence. ") +/** Same as [sub] but return a string instead of a byte sequence. */ let sub_string: (bytes, ~pos: int, ~len: int) => string -@ocaml.doc(" [extend s left right] returns a new byte sequence that contains +/** [extend s left right] returns a new byte sequence that contains the bytes of [s], with [left] uninitialized bytes prepended and [right] uninitialized bytes appended to it. If [left] or [right] is negative, then bytes are removed (instead of appended) from @@ -83,17 +83,17 @@ let sub_string: (bytes, ~pos: int, ~len: int) => string Raise [Invalid_argument] if the result length is negative or longer than {!Sys.max_string_length} bytes. - @since 4.05.0 ") + @since 4.05.0 */ let extend: (bytes, ~left: int, ~right: int) => bytes -@ocaml.doc(" [fill s start len c] modifies [s] in place, replacing [len] +/** [fill s start len c] modifies [s] in place, replacing [len] characters with [c], starting at [start]. Raise [Invalid_argument] if [start] and [len] do not designate a - valid range of [s]. ") + valid range of [s]. */ let fill: (bytes, ~pos: int, ~len: int, char) => unit -@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from sequence +/** [blit src srcoff dst dstoff len] copies [len] bytes from sequence [src], starting at index [srcoff], to sequence [dst], starting at index [dstoff]. It works correctly even if [src] and [dst] are the same byte sequence, and the source and destination intervals @@ -101,164 +101,164 @@ let fill: (bytes, ~pos: int, ~len: int, char) => unit Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. ") + do not designate a valid range of [dst]. */ let blit: (~src: bytes, ~src_pos: int, ~dst: bytes, ~dst_pos: int, ~len: int) => unit -@ocaml.doc(" [blit src srcoff dst dstoff len] copies [len] bytes from string +/** [blit src srcoff dst dstoff len] copies [len] bytes from string [src], starting at index [srcoff], to byte sequence [dst], starting at index [dstoff]. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] do not designate a valid range of [dst]. - @since 4.05.0 ") + @since 4.05.0 */ let blit_string: (~src: string, ~src_pos: int, ~dst: bytes, ~dst_pos: int, ~len: int) => unit -@ocaml.doc(" [concat sep sl] concatenates the list of byte sequences [sl], +/** [concat sep sl] concatenates the list of byte sequences [sl], inserting the separator byte sequence [sep] between each, and - returns the result as a new byte sequence. ") + returns the result as a new byte sequence. */ let concat: (~sep: bytes, list) => bytes -@ocaml.doc(" [cat s1 s2] concatenates [s1] and [s2] and returns the result +/** [cat s1 s2] concatenates [s1] and [s2] and returns the result as new byte sequence. Raise [Invalid_argument] if the result is longer than {!Sys.max_string_length} bytes. - @since 4.05.0 ") + @since 4.05.0 */ let cat: (bytes, bytes) => bytes -@ocaml.doc(" [iter f s] applies function [f] in turn to all the bytes of [s]. +/** [iter f s] applies function [f] in turn to all the bytes of [s]. It is equivalent to [f (get s 0); f (get s 1); ...; f (get s - (length s - 1)); ()]. ") + (length s - 1)); ()]. */ let iter: (~f: char => unit, bytes) => unit -@ocaml.doc(" Same as {!Bytes.iter}, but the function is applied to the index of +/** Same as {!Bytes.iter}, but the function is applied to the index of the byte as first argument and the byte itself as second - argument. ") + argument. */ let iteri: (~f: (int, char) => unit, bytes) => unit -@ocaml.doc(" [map f s] applies function [f] in turn to all the bytes of [s] and +/** [map f s] applies function [f] in turn to all the bytes of [s] and stores the resulting bytes in a new sequence that is returned as - the result. ") + the result. */ let map: (~f: char => char, bytes) => bytes -@ocaml.doc(" [mapi f s] calls [f] with each character of [s] and its +/** [mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the resulting bytes - in a new sequence that is returned as the result. ") + in a new sequence that is returned as the result. */ let mapi: (~f: (int, char) => char, bytes) => bytes -@ocaml.doc(" Return a copy of the argument, without leading and trailing +/** Return a copy of the argument, without leading and trailing whitespace. The bytes regarded as whitespace are the ASCII - characters [' '], ['\012'], ['\n'], ['\r'], and ['\t']. ") + characters [' '], ['\x0c'], ['\n'], ['\r'], and ['\t']. */ let trim: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with special characters represented - by escape sequences, following the lexical conventions of OCaml. ") +/** Return a copy of the argument, with special characters represented + by escape sequences, following the lexical conventions of OCaml. */ let escaped: bytes => bytes -@ocaml.doc(" [index s c] returns the index of the first occurrence of byte [c] +/** [index s c] returns the index of the first occurrence of byte [c] in [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let index: (bytes, char) => int -@ocaml.doc(" [index_opt s c] returns the index of the first occurrence of byte [c] +/** [index_opt s c] returns the index of the first occurrence of byte [c] in [s] or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let index_opt: (bytes, char) => option -@ocaml.doc(" [rindex s c] returns the index of the last occurrence of byte [c] +/** [rindex s c] returns the index of the last occurrence of byte [c] in [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let rindex: (bytes, char) => int -@ocaml.doc(" [rindex_opt s c] returns the index of the last occurrence of byte [c] +/** [rindex_opt s c] returns the index of the last occurrence of byte [c] in [s] or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let rindex_opt: (bytes, char) => option -@ocaml.doc(" [index_from s i c] returns the index of the first occurrence of +/** [index_from s i c] returns the index of the first occurrence of byte [c] in [s] after position [i]. [Bytes.index s c] is equivalent to [Bytes.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. ") + Raise [Not_found] if [c] does not occur in [s] after position [i]. */ let index_from: (bytes, int, char) => int -@ocaml.doc(" [index_from _opts i c] returns the index of the first occurrence of +/** [index_from _opts i c] returns the index of the first occurrence of byte [c] in [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. [Bytes.index_opt s c] is equivalent to [Bytes.index_from_opt s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - @since 4.05 ") + @since 4.05 */ let index_from_opt: (bytes, int, char) => option -@ocaml.doc(" [rindex_from s i c] returns the index of the last occurrence of +/** [rindex_from s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1]. [rindex s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. */ let rindex_from: (bytes, int, char) => int -@ocaml.doc(" [rindex_from_opt s i c] returns the index of the last occurrence +/** [rindex_from_opt s i c] returns the index of the last occurrence of byte [c] in [s] before position [i+1] or [None] if [c] does not occur in [s] before position [i+1]. [rindex_opt s c] is equivalent to [rindex_from s (Bytes.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - @since 4.05 ") + @since 4.05 */ let rindex_from_opt: (bytes, int, char) => option -@ocaml.doc(" [contains s c] tests if byte [c] appears in [s]. ") +/** [contains s c] tests if byte [c] appears in [s]. */ let contains: (bytes, char) => bool -@ocaml.doc(" [contains_from s start c] tests if byte [c] appears in [s] after +/** [contains_from s start c] tests if byte [c] appears in [s] after position [start]. [contains s c] is equivalent to [contains_from s 0 c]. - Raise [Invalid_argument] if [start] is not a valid position in [s]. ") + Raise [Invalid_argument] if [start] is not a valid position in [s]. */ let contains_from: (bytes, int, char) => bool -@ocaml.doc(" [rcontains_from s stop c] tests if byte [c] appears in [s] before +/** [rcontains_from s stop c] tests if byte [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. ") + position in [s]. */ let rcontains_from: (bytes, int, char) => bool -@ocaml.doc(" Return a copy of the argument, with all lowercase letters +/** Return a copy of the argument, with all lowercase letters translated to uppercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let uppercase_ascii: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with all uppercase letters +/** Return a copy of the argument, with all uppercase letters translated to lowercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let lowercase_ascii: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, +/** Return a copy of the argument, with the first character set to uppercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let capitalize_ascii: bytes => bytes -@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, +/** Return a copy of the argument, with the first character set to lowercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let uncapitalize_ascii: bytes => bytes -@ocaml.doc(" An alias for the type of byte sequences. ") +/** An alias for the type of byte sequences. */ type t = bytes -@ocaml.doc(" The comparison function for byte sequences, with the same +/** The comparison function for byte sequences, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Bytes] to be passed as - argument to the functors {!Set.Make} and {!Map.Make}. ") + argument to the functors {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equality function for byte sequences. - @since 4.05.0 ") +/** The equality function for byte sequences. + @since 4.05.0 */ let equal: (t, t) => bool @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/callback.resi b/jscomp/stdlib-406/callback.resi index 18db163797..56cc36bad5 100644 --- a/jscomp/stdlib-406/callback.resi +++ b/jscomp/stdlib-406/callback.resi @@ -20,15 +20,15 @@ OCaml functions, or raise registered OCaml exceptions. ") -@ocaml.doc(" [Callback.register n v] registers the value [v] under +/** [Callback.register n v] registers the value [v] under the name [n]. C code can later retrieve a handle to [v] - by calling [caml_named_value(n)]. ") + by calling [caml_named_value(n)]. */ let register: (string, 'a) => unit -@ocaml.doc(" [Callback.register_exception n exn] registers the +/** [Callback.register_exception n exn] registers the exception contained in the exception value [exn] under the name [n]. C code can later retrieve a handle to the exception by calling [caml_named_value(n)]. The exception value thus obtained is suitable for passing as first argument - to [raise_constant] or [raise_with_arg]. ") + to [raise_constant] or [raise_with_arg]. */ let register_exception: (string, exn) => unit diff --git a/jscomp/stdlib-406/char.resi b/jscomp/stdlib-406/char.resi index df3e413d52..713fb721a6 100644 --- a/jscomp/stdlib-406/char.resi +++ b/jscomp/stdlib-406/char.resi @@ -17,54 +17,54 @@ " Character operations. " ) -@ocaml.doc(" Return the ASCII code of the argument. ") +/** Return the ASCII code of the argument. */ external code: char => int = "%identity" -@ocaml.doc(" Return the character with the given ASCII code. +/** Return the character with the given ASCII code. Raise [Invalid_argument \"Char.chr\"] if the argument is - outside the range 0--255. ") + outside the range 0--255. */ let chr: int => char -@ocaml.doc(" Return a string representing the given character, +/** Return a string representing the given character, with special characters escaped following the lexical conventions of OCaml. All characters outside the ASCII printable range (32..126) are - escaped, as well as backslash, double-quote, and single-quote. ") + escaped, as well as backslash, double-quote, and single-quote. */ let escaped: char => string @ocaml.deprecated("Use Char.lowercase_ascii instead.") -@ocaml.doc(" Convert the given character to its equivalent lowercase character, +/** Convert the given character to its equivalent lowercase character, using the ISO Latin-1 (8859-1) character set. - @deprecated Functions operating on Latin-1 character set are deprecated. ") + @deprecated Functions operating on Latin-1 character set are deprecated. */ let lowercase: char => char @ocaml.deprecated("Use Char.uppercase_ascii instead.") -@ocaml.doc(" Convert the given character to its equivalent uppercase character, +/** Convert the given character to its equivalent uppercase character, using the ISO Latin-1 (8859-1) character set. - @deprecated Functions operating on Latin-1 character set are deprecated. ") + @deprecated Functions operating on Latin-1 character set are deprecated. */ let uppercase: char => char -@ocaml.doc(" Convert the given character to its equivalent lowercase character, +/** Convert the given character to its equivalent lowercase character, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let lowercase_ascii: char => char -@ocaml.doc(" Convert the given character to its equivalent uppercase character, +/** Convert the given character to its equivalent uppercase character, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let uppercase_ascii: char => char -@ocaml.doc(" An alias for the type of characters. ") +/** An alias for the type of characters. */ type t = char -@ocaml.doc(" The comparison function for characters, with the same specification as +/** The comparison function for characters, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Char] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. ") + {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equal function for chars. - @since 4.03.0 ") +/** The equal function for chars. + @since 4.03.0 */ let equal: (t, t) => bool @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/complex.resi b/jscomp/stdlib-406/complex.resi index 0a41e97953..6b89d3c80e 100644 --- a/jscomp/stdlib-406/complex.resi +++ b/jscomp/stdlib-406/complex.resi @@ -20,67 +20,67 @@ (cartesian representation). Each part is represented by a double-precision floating-point number (type [float]). ") -@ocaml.doc(" The type of complex numbers. [re] is the real part and [im] the - imaginary part. ") +/** The type of complex numbers. [re] is the real part and [im] the + imaginary part. */ type t = {re: float, im: float} -@ocaml.doc(" The complex number [0]. ") +/** The complex number [0]. */ let zero: t -@ocaml.doc(" The complex number [1]. ") +/** The complex number [1]. */ let one: t -@ocaml.doc(" The complex number [i]. ") +/** The complex number [i]. */ let i: t -@ocaml.doc(" Unary negation. ") +/** Unary negation. */ let neg: t => t -@ocaml.doc(" Conjugate: given the complex [x + i.y], returns [x - i.y]. ") +/** Conjugate: given the complex [x + i.y], returns [x - i.y]. */ let conj: t => t -@ocaml.doc(" Addition ") +/** Addition */ let add: (t, t) => t -@ocaml.doc(" Subtraction ") +/** Subtraction */ let sub: (t, t) => t -@ocaml.doc(" Multiplication ") +/** Multiplication */ let mul: (t, t) => t -@ocaml.doc(" Multiplicative inverse ([1/z]). ") +/** Multiplicative inverse ([1/z]). */ let inv: t => t -@ocaml.doc(" Division ") +/** Division */ let div: (t, t) => t -@ocaml.doc(" Square root. The result [x + i.y] is such that [x > 0] or +/** Square root. The result [x + i.y] is such that [x > 0] or [x = 0] and [y >= 0]. - This function has a discontinuity along the negative real axis. ") + This function has a discontinuity along the negative real axis. */ let sqrt: t => t -@ocaml.doc(" Norm squared: given [x + i.y], returns [x^2 + y^2]. ") +/** Norm squared: given [x + i.y], returns [x^2 + y^2]. */ let norm2: t => float -@ocaml.doc(" Norm: given [x + i.y], returns [sqrt(x^2 + y^2)]. ") +/** Norm: given [x + i.y], returns [sqrt(x^2 + y^2)]. */ let norm: t => float -@ocaml.doc(" Argument. The argument of a complex number is the angle +/** Argument. The argument of a complex number is the angle in the complex plane between the positive real axis and a line passing through zero and the number. This angle ranges from [-pi] to [pi]. This function has a discontinuity along the - negative real axis. ") + negative real axis. */ let arg: t => float -@ocaml.doc(" [polar norm arg] returns the complex having norm [norm] - and argument [arg]. ") +/** [polar norm arg] returns the complex having norm [norm] + and argument [arg]. */ let polar: (float, float) => t -@ocaml.doc(" Exponentiation. [exp z] returns [e] to the [z] power. ") +/** Exponentiation. [exp z] returns [e] to the [z] power. */ let exp: t => t -@ocaml.doc(" Natural logarithm (in base [e]). ") +/** Natural logarithm (in base [e]). */ let log: t => t -@ocaml.doc(" Power function. [pow z1 z2] returns [z1] to the [z2] power. ") +/** Power function. [pow z1 z2] returns [z1] to the [z2] power. */ let pow: (t, t) => t diff --git a/jscomp/stdlib-406/digest.resi b/jscomp/stdlib-406/digest.resi index 6664e4a701..dd6dfd3690 100644 --- a/jscomp/stdlib-406/digest.resi +++ b/jscomp/stdlib-406/digest.resi @@ -24,44 +24,44 @@ primitives should be used instead. ") -@ocaml.doc(" The type of digests: 16-character strings. ") +/** The type of digests: 16-character strings. */ type t = string -@ocaml.doc(" The comparison function for 16-character digest, with the same +/** 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 ") + @since 4.00.0 */ let compare: (t, t) => int -@ocaml.doc(" The equal function for 16-character digest. - @since 4.03.0 ") +/** The equal function for 16-character digest. + @since 4.03.0 */ let equal: (t, t) => bool -@ocaml.doc(" Return the digest of the given string. ") +/** Return the digest of the given string. */ let string: string => t -@ocaml.doc(" Return the digest of the given byte sequence. - @since 4.02.0 ") +/** Return the digest of the given byte sequence. + @since 4.02.0 */ let bytes: bytes => t -@ocaml.doc(" [Digest.substring s ofs len] returns the digest of the substring - of [s] starting at index [ofs] and containing [len] characters. ") +/** [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 -@ocaml.doc(" [Digest.subbytes s ofs len] returns the digest of the subsequence +/** [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 ") + @since 4.02.0 */ let subbytes: (bytes, int, int) => t -@ocaml.doc(" Return the printable hexadecimal representation of the given digest. +/** 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 -@ocaml.doc(" Convert a hexadecimal representation back into the corresponding digest. +/** 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 ") + @since 4.00.0 */ let from_hex: string => t diff --git a/jscomp/stdlib-406/filename.resi b/jscomp/stdlib-406/filename.resi index 284e54891c..3a77eea03d 100644 --- a/jscomp/stdlib-406/filename.resi +++ b/jscomp/stdlib-406/filename.resi @@ -17,41 +17,41 @@ " Operations on file names. " ) -@ocaml.doc(" The conventional name for the current directory (e.g. [.] in Unix). ") +/** The conventional name for the current directory (e.g. [.] in Unix). */ let current_dir_name: string -@ocaml.doc(" The conventional name for the parent of the current directory - (e.g. [..] in Unix). ") +/** The conventional name for the parent of the current directory + (e.g. [..] in Unix). */ let parent_dir_name: string -@ocaml.doc(" The directory separator (e.g. [/] in Unix). @since 3.11.2 ") +/** The directory separator (e.g. [/] in Unix). @since 3.11.2 */ let dir_sep: string -@ocaml.doc(" [concat dir file] returns a file name that designates file - [file] in directory [dir]. ") +/** [concat dir file] returns a file name that designates file + [file] in directory [dir]. */ let concat: (string, string) => string -@ocaml.doc(" Return [true] if the file name is relative to the current +/** Return [true] if the file name is relative to the current directory, [false] if it is absolute (i.e. in Unix, starts - with [/]). ") + with [/]). */ let is_relative: string => bool -@ocaml.doc(" Return [true] if the file name is relative and does not start +/** Return [true] if the file name is relative and does not start with an explicit reference to the current directory ([./] or [../] in Unix), [false] if it starts with an explicit reference - to the root directory or the current directory. ") + to the root directory or the current directory. */ let is_implicit: string => bool -@ocaml.doc(" [check_suffix name suff] returns [true] if the filename [name] - ends with the suffix [suff]. ") +/** [check_suffix name suff] returns [true] if the filename [name] + ends with the suffix [suff]. */ let check_suffix: (string, string) => bool -@ocaml.doc(" [chop_suffix name suff] removes the suffix [suff] from +/** [chop_suffix name suff] removes the suffix [suff] from the filename [name]. The behavior is undefined if [name] does not - end with the suffix [suff]. ") + end with the suffix [suff]. */ let chop_suffix: (string, string) => string -@ocaml.doc(" [extension name] is the shortest suffix [ext] of [name0] where: +/** [extension name] is the shortest suffix [ext] of [name0] where: - [name0] is the longest suffix of [name] that does not contain a directory separator; @@ -63,10 +63,10 @@ let chop_suffix: (string, string) => string string. @since 4.04 -") +*/ let extension: string => string -@ocaml.doc(" Return the given file name without its extension, as defined +/** Return the given file name without its extension, as defined in {!Filename.extension}. If the extension is empty, the function returns the given file name. @@ -75,14 +75,14 @@ let extension: string => string [remove_extension s ^ extension s = s] @since 4.04 -") +*/ let remove_extension: string => string -@ocaml.doc(" Same as {!Filename.remove_extension}, but raise [Invalid_argument] - if the given name has an empty extension. ") +/** Same as {!Filename.remove_extension}, but raise [Invalid_argument] + if the given name has an empty extension. */ let chop_extension: string => string -@ocaml.doc(" Split a file name into directory name / base file name. +/** Split a file name into directory name / base file name. If [name] is a valid file name, then [concat (dirname name) (basename name)] returns a file name which is equivalent to [name]. Moreover, after setting the current directory to [dirname name] (with {!Sys.chdir}), @@ -90,45 +90,45 @@ let chop_extension: string => string designate the same file as [name] before the call to {!Sys.chdir}. This function conforms to the specification of POSIX.1-2008 for the - [basename] utility. ") + [basename] utility. */ let basename: string => string -@ocaml.doc(" See {!Filename.basename}. +/** See {!Filename.basename}. This function conforms to the specification of POSIX.1-2008 for the - [dirname] utility. ") + [dirname] utility. */ let dirname: string => string -@ocaml.doc(" The name of the temporary directory: +/** The name of the temporary directory: Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" if the variable is not set. Under Windows, the value of the [TEMP] environment variable, or \".\" if the variable is not set. The temporary directory can be changed with {!Filename.set_temp_dir_name}. @since 4.00.0 -") +*/ let get_temp_dir_name: unit => string -@ocaml.doc(" Change the temporary directory returned by {!Filename.get_temp_dir_name} +/** Change the temporary directory returned by {!Filename.get_temp_dir_name} and used by {!Filename.temp_file} and {!Filename.open_temp_file}. @since 4.00.0 -") +*/ let set_temp_dir_name: string => unit @ocaml.deprecated("Use Filename.get_temp_dir_name instead") -@ocaml.doc(" The name of the initial temporary directory: +/** The name of the initial temporary directory: Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" if the variable is not set. Under Windows, the value of the [TEMP] environment variable, or \".\" if the variable is not set. @deprecated You should use {!Filename.get_temp_dir_name} instead. @since 3.09.1 -") +*/ let temp_dir_name: string -@ocaml.doc(" Return a quoted version of a file name, suitable for use as +/** Return a quoted version of a file name, suitable for use as one argument in a command line, escaping all meta-characters. Warning: under Windows, the output is only suitable for use with programs that follow the standard Windows quoting conventions. - ") + */ let quote: string => string diff --git a/jscomp/stdlib-406/genlex.resi b/jscomp/stdlib-406/genlex.resi index 14f659b8e9..c1179cbd12 100644 --- a/jscomp/stdlib-406/genlex.resi +++ b/jscomp/stdlib-406/genlex.resi @@ -45,14 +45,14 @@ [\"-pp\"] command-line switch of the compilers. ") -@ocaml.doc(" The type of tokens. The lexical classes are: [Int] and [Float] +/** The type of tokens. The lexical classes are: [Int] and [Float] for integer and floating-point numbers; [String] for string literals, enclosed in double quotes; [Char] for character literals, enclosed in single quotes; [Ident] for identifiers (either sequences of letters, digits, underscores and quotes, or sequences of 'operator characters' such as [+], [*], etc); and [Kwd] for keywords (either identifiers or - single 'special characters' such as [(], [}], etc). ") + single 'special characters' such as [(], [}], etc). */ type token = | Kwd(string) | Ident(string) @@ -61,7 +61,7 @@ type token = | String(string) | Char(char) -@ocaml.doc(" Construct the lexer function. The first argument is the list of +/** Construct the lexer function. The first argument is the list of keywords. An identifier [s] is returned as [Kwd s] if [s] belongs to this list, and as [Ident s] otherwise. A special character [s] is returned as [Kwd s] if [s] @@ -69,5 +69,5 @@ type token = {!Stream.Error} with the offending lexeme as its parameter) otherwise. Blanks and newlines are skipped. Comments delimited by [(*] and [*)] are skipped as well, and can be nested. A {!Stream.Failure} exception - is raised if end of stream is unexpectedly reached.") + is raised if end of stream is unexpectedly reached.*/ let make_lexer: (list, Stream.t) => Stream.t diff --git a/jscomp/stdlib-406/hashtbl.resi b/jscomp/stdlib-406/hashtbl.resi index bcf9c988db..861a679569 100644 --- a/jscomp/stdlib-406/hashtbl.resi +++ b/jscomp/stdlib-406/hashtbl.resi @@ -20,10 +20,10 @@ @@ocaml.text(" {1 Generic interface} ") -@ocaml.doc(" The type of hash tables from type ['a] to type ['b]. ") +/** The type of hash tables from type ['a] to type ['b]. */ type t<'a, 'b> -@ocaml.doc(" [Hashtbl.create n] creates a new, empty hash table, with +/** [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 @@ -59,59 +59,59 @@ type t<'a, 'b> 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. ") + hash tables were created in non-randomized mode. */ let create: (~random: bool=?, int) => t<'a, 'b> -@ocaml.doc(" Empty a hash table. Use [reset] instead of [clear] to shrink the - size of the bucket table to its initial size. ") +/** 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 -@ocaml.doc(" Empty a hash table and shrink the size of the bucket table +/** Empty a hash table and shrink the size of the bucket table to its initial size. - @since 4.00.0 ") + @since 4.00.0 */ let reset: t<'a, 'b> => unit -@ocaml.doc(" Return a copy of the given hashtable. ") +/** Return a copy of the given hashtable. */ let copy: t<'a, 'b> => t<'a, 'b> -@ocaml.doc(" [Hashtbl.add tbl x y] adds a binding of [x] to [y] in table [tbl]. +/** [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.) ") + (Same behavior as with association lists.) */ let add: (t<'a, 'b>, 'a, 'b) => unit -@ocaml.doc(" [Hashtbl.find tbl x] returns the current binding of [x] in [tbl], - or raises [Not_found] if no such binding exists. ") +/** [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 -@ocaml.doc(" [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl], +/** [Hashtbl.find_opt tbl x] returns the current binding of [x] in [tbl], or [None] if no such binding exists. - @since 4.05 ") + @since 4.05 */ let find_opt: (t<'a, 'b>, 'a) => option<'b> -@ocaml.doc(" [Hashtbl.find_all tbl x] returns the list of all data +/** [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. ") + bindings, in reverse order of introduction in the table. */ let find_all: (t<'a, 'b>, 'a) => list<'b> -@ocaml.doc(" [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. ") +/** [Hashtbl.mem tbl x] checks if [x] is bound in [tbl]. */ let mem: (t<'a, 'b>, 'a) => bool -@ocaml.doc(" [Hashtbl.remove tbl x] removes the current binding of [x] in [tbl], +/** [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]. ") + It does nothing if [x] is not bound in [tbl]. */ let remove: (t<'a, 'b>, 'a) => unit -@ocaml.doc(" [Hashtbl.replace tbl x y] replaces the current binding of [x] +/** [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]. ") + followed by {!Hashtbl.add}[ tbl x y]. */ let replace: (t<'a, 'b>, 'a, 'b) => unit -@ocaml.doc(" [Hashtbl.iter f tbl] applies [f] to all bindings in table [tbl]. +/** [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]. @@ -128,20 +128,20 @@ let replace: (t<'a, 'b>, 'a, 'b) => unit 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 -@ocaml.doc(" [Hashtbl.filter_map_inplace f tbl] applies [f] to all bindings in +/** [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 ") + @since 4.03.0 */ let filter_map_inplace: (('a, 'b) => option<'b>, t<'a, 'b>) => unit -@ocaml.doc(" [Hashtbl.fold f tbl init] computes +/** [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. @@ -160,16 +160,16 @@ let filter_map_inplace: (('a, 'b) => option<'b>, t<'a, 'b>) => unit 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 -@ocaml.doc(" [Hashtbl.length tbl] returns the number of bindings in [tbl]. +/** [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. ") + first argument. */ let length: t<'a, 'b> => int -@ocaml.doc(" After a call to [Hashtbl.randomize()], hash tables are created in +/** 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 @@ -185,33 +185,33 @@ let length: t<'a, 'b> => int This is intentional. Non-randomized hash tables can still be created using [Hashtbl.create ~random:false]. - @since 4.00.0 ") + @since 4.00.0 */ let randomize: unit => unit -@ocaml.doc(" return if the tables are currently created in randomized mode by default +/** return if the tables are currently created in randomized mode by default - @since 4.03.0 ") + @since 4.03.0 */ let is_randomized: unit => bool -@ocaml.doc(" @since 4.00.0 ") +/** @since 4.00.0 */ type statistics = { - @ocaml.doc(" Number of bindings present in the table. - Same value as returned by {!Hashtbl.length}. ") + /** Number of bindings present in the table. + Same value as returned by {!Hashtbl.length}. */ num_bindings: int, - @ocaml.doc(" Number of buckets in the table. ") + /** Number of buckets in the table. */ num_buckets: int, - @ocaml.doc(" Maximal number of bindings per bucket. ") + /** Maximal number of bindings per bucket. */ max_bucket_length: int, - @ocaml.doc(" Histogram of bucket sizes. This array [histo] has + /** 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]. ") + [histo.(i)] is the number of buckets whose size is [i]. */ bucket_histogram: array, } -@ocaml.doc(" [Hashtbl.stats tbl] returns statistics about the table [tbl]: +/** [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 ") + @since 4.00.0 */ let stats: t<'a, 'b> => statistics @@ocaml.text(" {1 Functorial interface} ") @@ -245,15 +245,15 @@ let stats: t<'a, 'b> => statistics [IntHashtbl.length]. ") -@ocaml.doc(" The input signature of the functor {!Hashtbl.Make}. ") +/** The input signature of the functor {!Hashtbl.Make}. */ module type HashedType = { - @ocaml.doc(" The type of the hashtable keys. ") + /** The type of the hashtable keys. */ type t - @ocaml.doc(" The equality predicate used to compare keys. ") + /** The equality predicate used to compare keys. */ let equal: (t, t) => bool - @ocaml.doc(" A hashing function on keys. It must be such that if two keys are + /** 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 @@ -264,40 +264,40 @@ module type HashedType = { 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). ") + equality (e.g. for mutable or cyclic objects). */ let hash: t => int } -@ocaml.doc(" The output signature of the functor {!Hashtbl.Make}. ") +/** 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 - @ocaml.doc(" @since 4.00.0 ") + /** @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 - @ocaml.doc(" @since 4.05.0 ") + /** @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 - @ocaml.doc(" @since 4.03.0 ") + /** @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 - @ocaml.doc(" @since 4.00.0 ") + /** @since 4.00.0 */ let stats: t<'a> => statistics } -@ocaml.doc(" Functor building an implementation of the hashtable structure. +/** 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]. @@ -306,28 +306,28 @@ module type S = { 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. ") + non-randomized hash tables. */ module Make: (H: HashedType) => (S with type key = H.t) -@ocaml.doc(" The input signature of the functor {!Hashtbl.MakeSeeded}. - @since 4.00.0 ") +/** The input signature of the functor {!Hashtbl.MakeSeeded}. + @since 4.00.0 */ module type SeededHashedType = { - @ocaml.doc(" The type of the hashtable keys. ") + /** The type of the hashtable keys. */ type t - @ocaml.doc(" The equality predicate used to compare keys. ") + /** The equality predicate used to compare keys. */ let equal: (t, t) => bool - @ocaml.doc(" A seeded hashing function on keys. The first argument is + /** 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. ") + below. */ let hash: (int, t) => int } -@ocaml.doc(" The output signature of the functor {!Hashtbl.MakeSeeded}. - @since 4.00.0 ") +/** The output signature of the functor {!Hashtbl.MakeSeeded}. + @since 4.00.0 */ module type SeededS = { type key type t<'a> @@ -338,14 +338,14 @@ module type SeededS = { let add: (t<'a>, key, 'a) => unit let remove: (t<'a>, key) => unit let find: (t<'a>, key) => 'a - @ocaml.doc(" @since 4.05.0 ") + /** @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 - @ocaml.doc(" @since 4.03.0 ") + /** @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 @@ -353,7 +353,7 @@ module type SeededS = { let stats: t<'a> => statistics } -@ocaml.doc(" Functor building an implementation of the hashtable structure. +/** 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]. @@ -364,23 +364,23 @@ module type SeededS = { 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 ") + @since 4.00.0 */ module MakeSeeded: (H: SeededHashedType) => (SeededS with type key = H.t) @@ocaml.text(" {1 The polymorphic hash functions} ") -@ocaml.doc(" [Hashtbl.hash x] associates a nonnegative integer to any value of +/** [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. ") + Moreover, [hash] always terminates, even on cyclic structures. */ let hash: 'a => int -@ocaml.doc(" A variant of {!Hashtbl.hash} that is further parameterized by +/** A variant of {!Hashtbl.hash} that is further parameterized by an integer seed. - @since 4.00.0 ") + @since 4.00.0 */ let seeded_hash: (int, 'a) => int -@ocaml.doc(" [Hashtbl.hash_param meaningful total x] computes a hash value for [x], +/** [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 @@ -396,11 +396,11 @@ let seeded_hash: (int, 'a) => int 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]. ") + [meaningful = 10] and [total = 100]. */ let hash_param: (int, int, 'a) => int -@ocaml.doc(" A variant of {!Hashtbl.hash_param} that is further parameterized by +/** 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 ") + @since 4.00.0 */ let seeded_hash_param: (int, int, int, 'a) => int diff --git a/jscomp/stdlib-406/int32.resi b/jscomp/stdlib-406/int32.resi index 784c8bb8a4..f63c5fa3a6 100644 --- a/jscomp/stdlib-406/int32.resi +++ b/jscomp/stdlib-406/int32.resi @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -@ocaml.doc(" 32-bit integers. +/** 32-bit integers. This module provides operations on the type [t] of signed 32-bit integers. Unlike the built-in [int] type, @@ -24,106 +24,106 @@ Performance notice: values of type [t] occupy more memory space than values of type [int], and arithmetic operations on [t] are generally slower than those on [int]. Use [t] - only when the application requires exact 32-bit arithmetic. ") -@ocaml.doc(" An alias for the type of 32-bit integers. ") + only when the application requires exact 32-bit arithmetic. */ +/** An alias for the type of 32-bit integers. */ type t = int -@ocaml.doc(" The 32-bit integer 0. ") +/** The 32-bit integer 0. */ let zero: t -@ocaml.doc(" The 32-bit integer 1. ") +/** The 32-bit integer 1. */ let one: t -@ocaml.doc(" The 32-bit integer -1. ") +/** The 32-bit integer -1. */ let minus_one: t -@ocaml.doc(" Unary negation. ") +/** Unary negation. */ external neg: t => t = "%negint" -@ocaml.doc(" Addition. ") +/** Addition. */ external add: (t, t) => t = "%addint" -@ocaml.doc(" Subtraction. ") +/** Subtraction. */ external sub: (t, t) => t = "%subint" -@ocaml.doc(" Multiplication. ") +/** Multiplication. */ external mul: (t, t) => t = "%mulint" -@ocaml.doc(" Integer division. Raise [Division_by_zero] if the second +/** Integer division. Raise [Division_by_zero] if the second argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. ") + its arguments towards zero, as specified for {!Pervasives.(/)}. */ external div: (t, t) => t = "%divint" -@ocaml.doc(" Integer remainder. If [y] is not zero, the result +/** Integer remainder. If [y] is not zero, the result of [Int32.rem x y] satisfies the following property: [x = Int32.add (Int32.mul (Int32.div x y) y) (Int32.rem x y)]. - If [y = 0], [Int32.rem x y] raises [Division_by_zero]. ") + If [y = 0], [Int32.rem x y] raises [Division_by_zero]. */ external rem: (t, t) => t = "%modint" -@ocaml.doc(" Successor. [Int32.succ x] is [Int32.add x Int32.one]. ") +/** Successor. [Int32.succ x] is [Int32.add x Int32.one]. */ let succ: t => t -@ocaml.doc(" Predecessor. [Int32.pred x] is [Int32.sub x Int32.one]. ") +/** Predecessor. [Int32.pred x] is [Int32.sub x Int32.one]. */ let pred: t => t -@ocaml.doc(" Return the absolute value of its argument. ") +/** Return the absolute value of its argument. */ let abs: t => t -@ocaml.doc(" The greatest representable 32-bit integer, 2{^31} - 1. ") +/** The greatest representable 32-bit integer, 2{^31} - 1. */ let max_int: t -@ocaml.doc(" The smallest representable 32-bit integer, -2{^31}. ") +/** The smallest representable 32-bit integer, -2{^31}. */ let min_int: t -@ocaml.doc(" Bitwise logical and. ") +/** Bitwise logical and. */ external logand: (t, t) => t = "%andint" -@ocaml.doc(" Bitwise logical or. ") +/** Bitwise logical or. */ external logor: (t, t) => t = "%orint" -@ocaml.doc(" Bitwise logical exclusive or. ") +/** Bitwise logical exclusive or. */ external logxor: (t, t) => t = "%xorint" -@ocaml.doc(" Bitwise logical negation. ") +/** Bitwise logical negation. */ let lognot: t => t -@ocaml.doc(" [Int32.shift_left x y] shifts [x] to the left by [y] bits. - The result is unspecified if [y < 0] or [y >= 32]. ") +/** [Int32.shift_left x y] shifts [x] to the left by [y] bits. + The result is unspecified if [y < 0] or [y >= 32]. */ external shift_left: (t, int) => t = "%lslint" -@ocaml.doc(" [Int32.shift_right x y] shifts [x] to the right by [y] bits. +/** [Int32.shift_right x y] shifts [x] to the right by [y] bits. This is an arithmetic shift: the sign bit of [x] is replicated and inserted in the vacated bits. - The result is unspecified if [y < 0] or [y >= 32]. ") + The result is unspecified if [y < 0] or [y >= 32]. */ external shift_right: (t, int) => t = "%asrint" -@ocaml.doc(" [Int32.shift_right_logical x y] shifts [x] to the right by [y] bits. +/** [Int32.shift_right_logical x y] shifts [x] to the right by [y] bits. This is a logical shift: zeroes are inserted in the vacated bits regardless of the sign of [x]. - The result is unspecified if [y < 0] or [y >= 32]. ") + The result is unspecified if [y < 0] or [y >= 32]. */ external shift_right_logical: (t, int) => t = "%lsrint" -@ocaml.doc(" Convert the given integer (type [int]) to a 32-bit integer - (type [t]). ") +/** Convert the given integer (type [int]) to a 32-bit integer + (type [t]). */ external of_int: int => t = "%identity" -@ocaml.doc(" Convert the given 32-bit integer (type [t]) to an +/** Convert the given 32-bit integer (type [t]) to an integer (type [int]). On 32-bit platforms, the 32-bit integer is taken modulo 2{^31}, i.e. the high-order bit is lost during the conversion. On 64-bit platforms, the conversion - is exact. ") + is exact. */ external to_int: t => int = "%identity" -@ocaml.doc(" Convert the given floating-point number to a 32-bit integer, +/** Convert the given floating-point number to a 32-bit integer, discarding the fractional part (truncate towards 0). The result of the conversion is undefined if, after truncation, - the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. ") + the number is outside the range \[{!Int32.min_int}, {!Int32.max_int}\]. */ external of_float: float => t = "?int_of_float" -@ocaml.doc(" Convert the given 32-bit integer to a floating-point number. ") +/** Convert the given 32-bit integer to a floating-point number. */ external to_float: t => float = "?int_to_float" -@ocaml.doc(" Convert the given string to a 32-bit integer. +/** Convert the given string to a 32-bit integer. The string is read in decimal (by default, or if the string begins with [0u]) or in hexadecimal, octal or binary if the string begins with [0x], [0o] or [0b] respectively. @@ -137,42 +137,42 @@ external to_float: t => float = "?int_to_float" and is ignored. Raise [Failure \"Int32.of_string\"] if the given string is not a valid representation of an integer, or if the integer represented - exceeds the range of integers representable in type [t]. ") + exceeds the range of integers representable in type [t]. */ external of_string: string => t = "?int_of_string" -@ocaml.doc(" Same as [of_string], but return [None] instead of raising. - @since 4.05 ") +/** Same as [of_string], but return [None] instead of raising. + @since 4.05 */ let of_string_opt: string => option -@ocaml.doc(" Return the string representation of its argument, in signed decimal. ") +/** Return the string representation of its argument, in signed decimal. */ let to_string: t => string -@ocaml.doc(" Return the internal representation of the given float according +/** Return the internal representation of the given float according to the IEEE 754 floating-point 'single format' bit layout. Bit 31 of the result represents the sign of the float; bits 30 to 23 represent the (biased) exponent; bits 22 to 0 - represent the mantissa. ") + represent the mantissa. */ external bits_of_float: float => t = "?int_bits_of_float" -@ocaml.doc(" Return the floating-point number whose internal representation, +/** Return the floating-point number whose internal representation, according to the IEEE 754 floating-point 'single format' bit layout, - is the given [t]. ") + is the given [t]. */ external float_of_bits: t => float = "?int_float_of_bits" -@ocaml.doc(" The comparison function for 32-bit integers, with the same specification as +/** The comparison function for 32-bit integers, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Int32] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. ") + {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equal function for int32s. - @since 4.03.0 ") +/** The equal function for int32s. + @since 4.03.0 */ let equal: (t, t) => bool @@ocaml.text("/*") @@ocaml.text(" {1 Deprecated functions} ") -@ocaml.doc(" Do not use this deprecated function. Instead, - used {!Printf.sprintf} with a [%l...] format. ") +/** Do not use this deprecated function. Instead, + used {!Printf.sprintf} with a [%l...] format. */ external format: (string, t) => string = "?format_int" diff --git a/jscomp/stdlib-406/int64.resi b/jscomp/stdlib-406/int64.resi index c1fc5cff4a..55e4e57056 100644 --- a/jscomp/stdlib-406/int64.resi +++ b/jscomp/stdlib-406/int64.resi @@ -27,113 +27,113 @@ only when the application requires exact 64-bit arithmetic. ") -@ocaml.doc(" The 64-bit integer 0. ") +/** The 64-bit integer 0. */ let zero: int64 -@ocaml.doc(" The 64-bit integer 1. ") +/** The 64-bit integer 1. */ let one: int64 -@ocaml.doc(" The 64-bit integer -1. ") +/** The 64-bit integer -1. */ let minus_one: int64 -@ocaml.doc(" Unary negation. ") +/** Unary negation. */ external neg: int64 => int64 = "%int64_neg" -@ocaml.doc(" Addition. ") +/** Addition. */ external add: (int64, int64) => int64 = "%int64_add" -@ocaml.doc(" Subtraction. ") +/** Subtraction. */ external sub: (int64, int64) => int64 = "%int64_sub" -@ocaml.doc(" Multiplication. ") +/** Multiplication. */ external mul: (int64, int64) => int64 = "%int64_mul" -@ocaml.doc(" Integer division. Raise [Division_by_zero] if the second +/** Integer division. Raise [Division_by_zero] if the second argument is zero. This division rounds the real quotient of - its arguments towards zero, as specified for {!Pervasives.(/)}. ") + its arguments towards zero, as specified for {!Pervasives.(/)}. */ external div: (int64, int64) => int64 = "%int64_div" -@ocaml.doc(" Integer remainder. If [y] is not zero, the result +/** Integer remainder. If [y] is not zero, the result of [Int64.rem x y] satisfies the following property: [x = Int64.add (Int64.mul (Int64.div x y) y) (Int64.rem x y)]. - If [y = 0], [Int64.rem x y] raises [Division_by_zero]. ") + If [y = 0], [Int64.rem x y] raises [Division_by_zero]. */ external rem: (int64, int64) => int64 = "%int64_mod" -@ocaml.doc(" Successor. [Int64.succ x] is [Int64.add x Int64.one]. ") +/** Successor. [Int64.succ x] is [Int64.add x Int64.one]. */ let succ: int64 => int64 -@ocaml.doc(" Predecessor. [Int64.pred x] is [Int64.sub x Int64.one]. ") +/** Predecessor. [Int64.pred x] is [Int64.sub x Int64.one]. */ let pred: int64 => int64 -@ocaml.doc(" Return the absolute value of its argument. ") +/** Return the absolute value of its argument. */ let abs: int64 => int64 -@ocaml.doc(" The greatest representable 64-bit integer, 2{^63} - 1. ") +/** The greatest representable 64-bit integer, 2{^63} - 1. */ let max_int: int64 -@ocaml.doc(" The smallest representable 64-bit integer, -2{^63}. ") +/** The smallest representable 64-bit integer, -2{^63}. */ let min_int: int64 -@ocaml.doc(" Bitwise logical and. ") +/** Bitwise logical and. */ external logand: (int64, int64) => int64 = "%int64_and" -@ocaml.doc(" Bitwise logical or. ") +/** Bitwise logical or. */ external logor: (int64, int64) => int64 = "%int64_or" -@ocaml.doc(" Bitwise logical exclusive or. ") +/** Bitwise logical exclusive or. */ external logxor: (int64, int64) => int64 = "%int64_xor" -@ocaml.doc(" Bitwise logical negation. ") +/** Bitwise logical negation. */ let lognot: int64 => int64 -@ocaml.doc(" [Int64.shift_left x y] shifts [x] to the left by [y] bits. - The result is unspecified if [y < 0] or [y >= 64]. ") +/** [Int64.shift_left x y] shifts [x] to the left by [y] bits. + The result is unspecified if [y < 0] or [y >= 64]. */ external shift_left: (int64, int) => int64 = "%int64_lsl" -@ocaml.doc(" [Int64.shift_right x y] shifts [x] to the right by [y] bits. +/** [Int64.shift_right x y] shifts [x] to the right by [y] bits. This is an arithmetic shift: the sign bit of [x] is replicated and inserted in the vacated bits. - The result is unspecified if [y < 0] or [y >= 64]. ") + The result is unspecified if [y < 0] or [y >= 64]. */ external shift_right: (int64, int) => int64 = "%int64_asr" -@ocaml.doc(" [Int64.shift_right_logical x y] shifts [x] to the right by [y] bits. +/** [Int64.shift_right_logical x y] shifts [x] to the right by [y] bits. This is a logical shift: zeroes are inserted in the vacated bits regardless of the sign of [x]. - The result is unspecified if [y < 0] or [y >= 64]. ") + The result is unspecified if [y < 0] or [y >= 64]. */ external shift_right_logical: (int64, int) => int64 = "%int64_lsr" -@ocaml.doc(" Convert the given integer (type [int]) to a 64-bit integer - (type [int64]). ") +/** Convert the given integer (type [int]) to a 64-bit integer + (type [int64]). */ external of_int: int => int64 = "%int64_of_int" -@ocaml.doc(" Convert the given 64-bit integer (type [int64]) to an +/** Convert the given 64-bit integer (type [int64]) to an integer (type [int]). On 64-bit platforms, the 64-bit integer is taken modulo 2{^63}, i.e. the high-order bit is lost during the conversion. On 32-bit platforms, the 64-bit integer is taken modulo 2{^31}, i.e. the top 33 bits are lost - during the conversion. ") + during the conversion. */ external to_int: int64 => int = "%int64_to_int" -@ocaml.doc(" Convert the given floating-point number to a 64-bit integer, +/** Convert the given floating-point number to a 64-bit integer, discarding the fractional part (truncate towards 0). The result of the conversion is undefined if, after truncation, - the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. ") + the number is outside the range \[{!Int64.min_int}, {!Int64.max_int}\]. */ external of_float: float => int64 = "?int64_of_float" -@ocaml.doc(" Convert the given 64-bit integer to a floating-point number. ") +/** Convert the given 64-bit integer to a floating-point number. */ external to_float: int64 => float = "?int64_to_float" -@ocaml.doc(" Convert the given 32-bit integer (type [int]) - to a 64-bit integer (type [int64]). ") +/** Convert the given 32-bit integer (type [int]) + to a 64-bit integer (type [int64]). */ external of_int32: int => int64 = "%int64_of_int32" -@ocaml.doc(" Convert the given 64-bit integer (type [int64]) to a +/** Convert the given 64-bit integer (type [int64]) to a 32-bit integer (type [int]). The 64-bit integer is taken modulo 2{^32}, i.e. the top 32 bits are lost - during the conversion. ") + during the conversion. */ external to_int32: int64 => int = "%int64_to_int32" -@ocaml.doc(" Convert the given string to a 64-bit integer. +/** Convert the given string to a 64-bit integer. The string is read in decimal (by default, or if the string begins with [0u]) or in hexadecimal, octal or binary if the string begins with [0x], [0o] or [0b] respectively. @@ -147,45 +147,45 @@ external to_int32: int64 => int = "%int64_to_int32" and is ignored. Raise [Failure \"Int64.of_string\"] if the given string is not a valid representation of an integer, or if the integer represented - exceeds the range of integers representable in type [int64]. ") + exceeds the range of integers representable in type [int64]. */ external of_string: string => int64 = "?int64_of_string" -@ocaml.doc(" Same as [of_string], but return [None] instead of raising. - @since 4.05 ") +/** Same as [of_string], but return [None] instead of raising. + @since 4.05 */ let of_string_opt: string => option -@ocaml.doc(" Return the string representation of its argument, in decimal. ") +/** Return the string representation of its argument, in decimal. */ let to_string: int64 => string -@ocaml.doc(" Return the internal representation of the given float according +/** Return the internal representation of the given float according to the IEEE 754 floating-point 'double format' bit layout. Bit 63 of the result represents the sign of the float; bits 62 to 52 represent the (biased) exponent; bits 51 to 0 - represent the mantissa. ") + represent the mantissa. */ external bits_of_float: float => int64 = "?int64_bits_of_float" -@ocaml.doc(" Return the floating-point number whose internal representation, +/** Return the floating-point number whose internal representation, according to the IEEE 754 floating-point 'double format' bit layout, - is the given [int64]. ") + is the given [int64]. */ external float_of_bits: int64 => float = "?int64_float_of_bits" -@ocaml.doc(" An alias for the type of 64-bit integers. ") +/** An alias for the type of 64-bit integers. */ type t = int64 -@ocaml.doc(" The comparison function for 64-bit integers, with the same specification as +/** The comparison function for 64-bit integers, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [Int64] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. ") + {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equal function for int64s. - @since 4.03.0 ") +/** The equal function for int64s. + @since 4.03.0 */ let equal: (t, t) => bool @@ocaml.text("/*") @@ocaml.text(" {1 Deprecated functions} ") -@ocaml.doc(" Do not use this deprecated function. Instead, - used {!Printf.sprintf} with a [%L...] format. ") +/** Do not use this deprecated function. Instead, + used {!Printf.sprintf} with a [%L...] format. */ external format: (string, int64) => string = "?int64_format" diff --git a/jscomp/stdlib-406/lazy.resi b/jscomp/stdlib-406/lazy.resi index 42bbcf2714..cf8d3c2ecd 100644 --- a/jscomp/stdlib-406/lazy.resi +++ b/jscomp/stdlib-406/lazy.resi @@ -17,7 +17,7 @@ " Deferred computations. " ) -@ocaml.doc(" A value of type ['a Lazy.t] is a deferred computation, called +/** A value of type ['a Lazy.t] is a deferred computation, called a suspension, that has a result of type ['a]. The special expression syntax [lazy (expr)] makes a suspension of the computation of [expr], without computing [expr] itself yet. @@ -38,56 +38,56 @@ loops in the garbage collector and other parts of the run-time system. Without the [-rectypes] option, such ill-founded recursive definitions are rejected by the type-checker. -") +*/ type t<'a> = lazy_t<'a> exception Undefined /* val force : 'a t -> 'a */ -@ocaml.doc(" [force x] forces the suspension [x] and returns its result. +/** [force x] forces the suspension [x] and returns its result. If [x] has already been forced, [Lazy.force x] returns the same value again without recomputing it. If it raised an exception, the same exception is raised again. Raise {!Undefined} if the forcing of [x] tries to force [x] itself recursively. -") +*/ external force: t<'a> => 'a = "%lazy_force" -@ocaml.doc(" [force_val x] forces the suspension [x] and returns its +/** [force_val x] forces the suspension [x] and returns its result. If [x] has already been forced, [force_val x] returns the same value again without recomputing it. Raise {!Undefined} if the forcing of [x] tries to force [x] itself recursively. If the computation of [x] raises an exception, it is unspecified whether [force_val x] raises the same exception or {!Undefined}. -") +*/ let force_val: t<'a> => 'a -@ocaml.doc(" [from_fun f] is the same as [lazy (f ())] but slightly more efficient. +/** [from_fun f] is the same as [lazy (f ())] but slightly more efficient. [from_fun] should only be used if the function [f] is already defined. In particular it is always less efficient to write [from_fun (fun () -> expr)] than [lazy expr]. - @since 4.00.0 ") + @since 4.00.0 */ let from_fun: (unit => 'a) => t<'a> -@ocaml.doc(" [from_val v] returns an already-forced suspension of [v]. +/** [from_val v] returns an already-forced suspension of [v]. This is for special purposes only and should not be confused with [lazy (v)]. - @since 4.00.0 ") + @since 4.00.0 */ let from_val: 'a => t<'a> -@ocaml.doc(" [is_val x] returns [true] if [x] has already been forced and +/** [is_val x] returns [true] if [x] has already been forced and did not raise an exception. - @since 4.00.0 ") + @since 4.00.0 */ let is_val: t<'a> => bool -@ocaml.deprecated("Use Lazy.from_fun instead.") @ocaml.doc(" @deprecated synonym for [from_fun]. ") +@ocaml.deprecated("Use Lazy.from_fun instead.") /** @deprecated synonym for [from_fun]. */ let lazy_from_fun: (unit => 'a) => t<'a> -@ocaml.deprecated("Use Lazy.from_val instead.") @ocaml.doc(" @deprecated synonym for [from_val]. ") +@ocaml.deprecated("Use Lazy.from_val instead.") /** @deprecated synonym for [from_val]. */ let lazy_from_val: 'a => t<'a> -@ocaml.deprecated("Use Lazy.is_val instead.") @ocaml.doc(" @deprecated synonym for [is_val]. ") +@ocaml.deprecated("Use Lazy.is_val instead.") /** @deprecated synonym for [is_val]. */ let lazy_is_val: t<'a> => bool diff --git a/jscomp/stdlib-406/lexing.resi b/jscomp/stdlib-406/lexing.resi index 705e02071d..6c3c857fa2 100644 --- a/jscomp/stdlib-406/lexing.resi +++ b/jscomp/stdlib-406/lexing.resi @@ -19,7 +19,7 @@ @@ocaml.text(" {1 Positions} ") -@ocaml.doc(" A value of type [position] describes a point in a source file. +/** A value of type [position] describes a point in a source file. [pos_fname] is the file name; [pos_lnum] is the line number; [pos_bol] is the offset of the beginning of the line (number of characters between the beginning of the lexbuf and the beginning @@ -31,7 +31,7 @@ See the documentation of type [lexbuf] for information about how the lexing engine will manage positions. - ") + */ type position = { pos_fname: string, pos_lnum: int, @@ -39,14 +39,14 @@ type position = { pos_cnum: int, } -@ocaml.doc(" A value of type [position], guaranteed to be different from any +/** A value of type [position], guaranteed to be different from any valid position. - ") + */ let dummy_pos: position @@ocaml.text(" {1 Lexer buffers} ") -@ocaml.doc(" The type of lexer buffers. A lexer buffer is the argument passed +/** The type of lexer buffers. A lexer buffer is the argument passed to the scanning functions defined by the generated scanners. The lexer buffer holds the current state of the scanner, plus a function to refill the buffer from the input. @@ -59,7 +59,7 @@ let dummy_pos: position accurate, they must be initialised before the first use of the lexbuf, and updated by the relevant lexer actions (i.e. at each end of line -- see also [new_line]). - ") + */ type rec lexbuf = { refill_buff: lexbuf => unit, mutable lex_buffer: bytes, @@ -75,18 +75,18 @@ type rec lexbuf = { mutable lex_curr_p: position, } -@ocaml.doc(" Create a lexer buffer which reads from +/** Create a lexer buffer which reads from the given string. Reading starts from the first character in the string. An end-of-input condition is generated when the - end of the string is reached. ") + end of the string is reached. */ let from_string: string => lexbuf -@ocaml.doc(" Create a lexer buffer with the given function as its reading method. +/** Create a lexer buffer with the given function as its reading method. When the scanner needs more characters, it will call the given function, giving it a byte sequence [s] and a byte count [n]. The function should put [n] bytes or fewer in [s], starting at index 0, and return the number of bytes - provided. A return value of 0 means end of input. ") + provided. A return value of 0 means end of input. */ let from_function: ((bytes, int) => int) => lexbuf @@ocaml.text(" {1 Functions for lexer semantic actions} ") @@ -100,44 +100,44 @@ let from_function: ((bytes, int) => int) => lexbuf [ocamllex], is bound to the lexer buffer passed to the parsing function. ") -@ocaml.doc(" [Lexing.lexeme lexbuf] returns the string matched by - the regular expression. ") +/** [Lexing.lexeme lexbuf] returns the string matched by + the regular expression. */ let lexeme: lexbuf => string -@ocaml.doc(" [Lexing.lexeme_char lexbuf i] returns character number [i] in - the matched string. ") +/** [Lexing.lexeme_char lexbuf i] returns character number [i] in + the matched string. */ let lexeme_char: (lexbuf, int) => char -@ocaml.doc(" [Lexing.lexeme_start lexbuf] returns the offset in the +/** [Lexing.lexeme_start lexbuf] returns the offset in the input stream of the first character of the matched string. - The first character of the stream has offset 0. ") + The first character of the stream has offset 0. */ let lexeme_start: lexbuf => int -@ocaml.doc(" [Lexing.lexeme_end lexbuf] returns the offset in the input stream +/** [Lexing.lexeme_end lexbuf] returns the offset in the input stream of the character following the last character of the matched - string. The first character of the stream has offset 0. ") + string. The first character of the stream has offset 0. */ let lexeme_end: lexbuf => int -@ocaml.doc(" Like [lexeme_start], but return a complete [position] instead - of an offset. ") +/** Like [lexeme_start], but return a complete [position] instead + of an offset. */ let lexeme_start_p: lexbuf => position -@ocaml.doc(" Like [lexeme_end], but return a complete [position] instead - of an offset. ") +/** Like [lexeme_end], but return a complete [position] instead + of an offset. */ let lexeme_end_p: lexbuf => position -@ocaml.doc(" Update the [lex_curr_p] field of the lexbuf to reflect the start +/** Update the [lex_curr_p] field of the lexbuf to reflect the start of a new line. You can call this function in the semantic action of the rule that matches the end-of-line character. @since 3.11.0 -") +*/ let new_line: lexbuf => unit @@ocaml.text(" {1 Miscellaneous functions} ") -@ocaml.doc(" Discard the contents of the buffer and reset the current +/** Discard the contents of the buffer and reset the current position to 0. The next use of the lexbuf will trigger a - refill. ") + refill. */ let flush_input: lexbuf => unit @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/list.resi b/jscomp/stdlib-406/list.resi index 8b04d7adb0..2254165aa7 100644 --- a/jscomp/stdlib-406/list.resi +++ b/jscomp/stdlib-406/list.resi @@ -26,270 +26,270 @@ longer than about 10000 elements. ") -@ocaml.doc(" Return the length (number of elements) of the given list. ") +/** Return the length (number of elements) of the given list. */ let length: list<'a> => int -@ocaml.doc(" Compare the lengths of two lists. [compare_lengths l1 l2] is +/** Compare the lengths of two lists. [compare_lengths l1 l2] is equivalent to [compare (length l1) (length l2)], except that the computation stops after itering on the shortest list. @since 4.05.0 - ") + */ let compare_lengths: (list<'a>, list<'b>) => int -@ocaml.doc(" Compare the length of a list to an integer. [compare_length_with l n] is +/** Compare the length of a list to an integer. [compare_length_with l n] is equivalent to [compare (length l) n], except that the computation stops after at most [n] iterations on the list. @since 4.05.0 -") +*/ let compare_length_with: (list<'a>, int) => int -@ocaml.doc(" [cons x xs] is [x :: xs] +/** [cons x xs] is [x :: xs] @since 4.03.0 -") +*/ let cons: ('a, list<'a>) => list<'a> -@ocaml.doc(" Return the first element of the given list. Raise - [Failure \"hd\"] if the list is empty. ") +/** Return the first element of the given list. Raise + [Failure \"hd\"] if the list is empty. */ let hd: list<'a> => 'a -@ocaml.doc(" Return the given list without its first element. Raise - [Failure \"tl\"] if the list is empty. ") +/** Return the given list without its first element. Raise + [Failure \"tl\"] if the list is empty. */ let tl: list<'a> => list<'a> -@ocaml.doc(" Return the [n]-th element of the given list. +/** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. Raise [Failure \"nth\"] if the list is too short. - Raise [Invalid_argument \"List.nth\"] if [n] is negative. ") + Raise [Invalid_argument \"List.nth\"] if [n] is negative. */ let nth: (list<'a>, int) => 'a -@ocaml.doc(" Return the [n]-th element of the given list. +/** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. Return [None] if the list is too short. Raise [Invalid_argument \"List.nth\"] if [n] is negative. @since 4.05 -") +*/ let nth_opt: (list<'a>, int) => option<'a> -@ocaml.doc(" List reversal. ") +/** List reversal. */ let rev: list<'a> => list<'a> -@ocaml.doc(" [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. +/** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. @raise Invalid_argument if len < 0. @since 4.06.0 -") +*/ let init: (int, int => 'a) => list<'a> -@ocaml.doc(" Concatenate two lists. Same as the infix operator [@]. - Not tail-recursive (length of the first argument). ") +/** Concatenate two lists. Same as the infix operator [@]. + Not tail-recursive (length of the first argument). */ let append: (list<'a>, list<'a>) => list<'a> -@ocaml.doc(" [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. +/** [List.rev_append l1 l2] reverses [l1] and concatenates it to [l2]. This is equivalent to {!List.rev}[ l1 @ l2], but [rev_append] is - tail-recursive and more efficient. ") + tail-recursive and more efficient. */ let rev_append: (list<'a>, list<'a>) => list<'a> -@ocaml.doc(" Concatenate a list of lists. The elements of the argument are all +/** Concatenate a list of lists. The elements of the argument are all concatenated together (in the same order) to give the result. Not tail-recursive - (length of the argument + length of the longest sub-list). ") + (length of the argument + length of the longest sub-list). */ let concat: list> => list<'a> -@ocaml.doc(" An alias for [concat]. ") +/** An alias for [concat]. */ let flatten: list> => list<'a> @@ocaml.text(" {1 Iterators} ") -@ocaml.doc(" [List.iter f [a1; ...; an]] applies function [f] in turn to +/** [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an]. It is equivalent to - [begin f a1; f a2; ...; f an; () end]. ") + [begin f a1; f a2; ...; f an; () end]. */ let iter: ('a => unit, list<'a>) => unit -@ocaml.doc(" Same as {!List.iter}, but the function is applied to the index of +/** Same as {!List.iter}, but the function is applied to the index of the element as first argument (counting from 0), and the element itself as second argument. @since 4.00.0 -") +*/ let iteri: ((int, 'a) => unit, list<'a>) => unit -@ocaml.doc(" [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], +/** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] - with the results returned by [f]. Not tail-recursive. ") + with the results returned by [f]. Not tail-recursive. */ let map: ('a => 'b, list<'a>) => list<'b> -@ocaml.doc(" Same as {!List.map}, but the function is applied to the index of +/** Same as {!List.map}, but the function is applied to the index of the element as first argument (counting from 0), and the element itself as second argument. Not tail-recursive. @since 4.00.0 -") +*/ let mapi: ((int, 'a) => 'b, list<'a>) => list<'b> -@ocaml.doc(" [List.rev_map f l] gives the same result as +/** [List.rev_map f l] gives the same result as {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and - more efficient. ") + more efficient. */ let rev_map: ('a => 'b, list<'a>) => list<'b> -@ocaml.doc(" [List.fold_left f a [b1; ...; bn]] is - [f (... (f (f a b1) b2) ...) bn]. ") +/** [List.fold_left f a [b1; ...; bn]] is + [f (... (f (f a b1) b2) ...) bn]. */ let fold_left: (('a, 'b) => 'a, 'a, list<'b>) => 'a -@ocaml.doc(" [List.fold_right f [a1; ...; an] b] is - [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. ") +/** [List.fold_right f [a1; ...; an] b] is + [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. */ let fold_right: (('a, 'b) => 'b, list<'a>, 'b) => 'b @@ocaml.text(" {1 Iterators on two lists} ") -@ocaml.doc(" [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn +/** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let iter2: (('a, 'b) => unit, list<'a>, list<'b>) => unit -@ocaml.doc(" [List.map2 f [a1; ...; an] [b1; ...; bn]] is +/** [List.map2 f [a1; ...; an] [b1; ...; bn]] is [[f a1 b1; ...; f an bn]]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. ") + to have different lengths. Not tail-recursive. */ let map2: (('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> -@ocaml.doc(" [List.rev_map2 f l1 l2] gives the same result as +/** [List.rev_map2 f l1 l2] gives the same result as {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and - more efficient. ") + more efficient. */ let rev_map2: (('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> -@ocaml.doc(" [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is +/** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let fold_left2: (('a, 'b, 'c) => 'a, 'a, list<'b>, list<'c>) => 'a -@ocaml.doc(" [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is +/** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. ") + to have different lengths. Not tail-recursive. */ let fold_right2: (('a, 'b, 'c) => 'c, list<'a>, list<'b>, 'c) => 'c @@ocaml.text(" {1 List scanning} ") -@ocaml.doc(" [for_all p [a1; ...; an]] checks if all elements of the list +/** [for_all p [a1; ...; an]] checks if all elements of the list satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. ") + [(p a1) && (p a2) && ... && (p an)]. */ let for_all: ('a => bool, list<'a>) => bool -@ocaml.doc(" [exists p [a1; ...; an]] checks if at least one element of +/** [exists p [a1; ...; an]] checks if at least one element of the list satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. ") + [(p a1) || (p a2) || ... || (p an)]. */ let exists: ('a => bool, list<'a>) => bool -@ocaml.doc(" Same as {!List.for_all}, but for a two-argument predicate. +/** Same as {!List.for_all}, but for a two-argument predicate. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let for_all2: (('a, 'b) => bool, list<'a>, list<'b>) => bool -@ocaml.doc(" Same as {!List.exists}, but for a two-argument predicate. +/** Same as {!List.exists}, but for a two-argument predicate. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let exists2: (('a, 'b) => bool, list<'a>, list<'b>) => bool -@ocaml.doc(" [mem a l] is true if and only if [a] is equal - to an element of [l]. ") +/** [mem a l] is true if and only if [a] is equal + to an element of [l]. */ let mem: ('a, list<'a>) => bool -@ocaml.doc(" Same as {!List.mem}, but uses physical equality instead of structural - equality to compare list elements. ") +/** Same as {!List.mem}, but uses physical equality instead of structural + equality to compare list elements. */ let memq: ('a, list<'a>) => bool @@ocaml.text(" {1 List searching} ") -@ocaml.doc(" [find p l] returns the first element of the list [l] +/** [find p l] returns the first element of the list [l] that satisfies the predicate [p]. Raise [Not_found] if there is no value that satisfies [p] in the - list [l]. ") + list [l]. */ let find: ('a => bool, list<'a>) => 'a -@ocaml.doc(" [find_opt p l] returns the first element of the list [l] that +/** [find_opt p l] returns the first element of the list [l] that satisfies the predicate [p], or [None] if there is no value that satisfies [p] in the list [l]. - @since 4.05 ") + @since 4.05 */ let find_opt: ('a => bool, list<'a>) => option<'a> -@ocaml.doc(" [filter p l] returns all the elements of the list [l] +/** [filter p l] returns all the elements of the list [l] that satisfy the predicate [p]. The order of the elements - in the input list is preserved. ") + in the input list is preserved. */ let filter: ('a => bool, list<'a>) => list<'a> -@ocaml.doc(" [find_all] is another name for {!List.filter}. ") +/** [find_all] is another name for {!List.filter}. */ let find_all: ('a => bool, list<'a>) => list<'a> -@ocaml.doc(" [partition p l] returns a pair of lists [(l1, l2)], where +/** [partition p l] returns a pair of lists [(l1, l2)], where [l1] is the list of all the elements of [l] that satisfy the predicate [p], and [l2] is the list of all the elements of [l] that do not satisfy [p]. - The order of the elements in the input list is preserved. ") + The order of the elements in the input list is preserved. */ let partition: ('a => bool, list<'a>) => (list<'a>, list<'a>) @@ocaml.text(" {1 Association lists} ") -@ocaml.doc(" [assoc a l] returns the value associated with key [a] in the list of +/** [assoc a l] returns the value associated with key [a] in the list of pairs [l]. That is, [assoc a [ ...; (a,b); ...] = b] if [(a,b)] is the leftmost binding of [a] in list [l]. Raise [Not_found] if there is no value associated with [a] in the - list [l]. ") + list [l]. */ let assoc: ('a, list<('a, 'b)>) => 'b -@ocaml.doc(" [assoc_opt a l] returns the value associated with key [a] in the list of +/** [assoc_opt a l] returns the value associated with key [a] in the list of pairs [l]. That is, [assoc_opt a [ ...; (a,b); ...] = b] if [(a,b)] is the leftmost binding of [a] in list [l]. Returns [None] if there is no value associated with [a] in the list [l]. - @since 4.05 ") + @since 4.05 */ let assoc_opt: ('a, list<('a, 'b)>) => option<'b> -@ocaml.doc(" Same as {!List.assoc}, but uses physical equality instead of structural - equality to compare keys. ") +/** Same as {!List.assoc}, but uses physical equality instead of structural + equality to compare keys. */ let assq: ('a, list<('a, 'b)>) => 'b -@ocaml.doc(" Same as {!List.assoc_opt}, but uses physical equality instead of structural +/** Same as {!List.assoc_opt}, but uses physical equality instead of structural equality to compare keys. - @since 4.05 ") + @since 4.05 */ let assq_opt: ('a, list<('a, 'b)>) => option<'b> -@ocaml.doc(" Same as {!List.assoc}, but simply return true if a binding exists, - and false if no bindings exist for the given key. ") +/** Same as {!List.assoc}, but simply return true if a binding exists, + and false if no bindings exist for the given key. */ let mem_assoc: ('a, list<('a, 'b)>) => bool -@ocaml.doc(" Same as {!List.mem_assoc}, but uses physical equality instead of - structural equality to compare keys. ") +/** Same as {!List.mem_assoc}, but uses physical equality instead of + structural equality to compare keys. */ let mem_assq: ('a, list<('a, 'b)>) => bool -@ocaml.doc(" [remove_assoc a l] returns the list of +/** [remove_assoc a l] returns the list of pairs [l] without the first pair with key [a], if any. - Not tail-recursive. ") + Not tail-recursive. */ let remove_assoc: ('a, list<('a, 'b)>) => list<('a, 'b)> -@ocaml.doc(" Same as {!List.remove_assoc}, but uses physical equality instead - of structural equality to compare keys. Not tail-recursive. ") +/** Same as {!List.remove_assoc}, but uses physical equality instead + of structural equality to compare keys. Not tail-recursive. */ let remove_assq: ('a, list<('a, 'b)>) => list<('a, 'b)> @@ocaml.text(" {1 Lists of pairs} ") -@ocaml.doc(" Transform a list of pairs into a pair of lists: +/** Transform a list of pairs into a pair of lists: [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. Not tail-recursive. -") +*/ let split: list<('a, 'b)> => (list<'a>, list<'b>) -@ocaml.doc(" Transform a pair of lists into a list of pairs: +/** Transform a pair of lists into a list of pairs: [combine [a1; ...; an] [b1; ...; bn]] is [[(a1,b1); ...; (an,bn)]]. Raise [Invalid_argument] if the two lists - have different lengths. Not tail-recursive. ") + have different lengths. Not tail-recursive. */ let combine: (list<'a>, list<'b>) => list<('a, 'b)> @@ocaml.text(" {1 Sorting} ") -@ocaml.doc(" Sort a list in increasing order according to a comparison +/** Sort a list in increasing order according to a comparison function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see Array.sort for @@ -302,32 +302,32 @@ let combine: (list<'a>, list<'b>) => list<('a, 'b)> The current implementation uses Merge Sort. It runs in constant heap space and logarithmic stack space. -") +*/ let sort: (('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Same as {!List.sort}, but the sorting algorithm is guaranteed to +/** Same as {!List.sort}, but the sorting algorithm is guaranteed to be stable (i.e. elements that compare equal are kept in their original order) . The current implementation uses Merge Sort. It runs in constant heap space and logarithmic stack space. -") +*/ let stable_sort: (('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Same as {!List.sort} or {!List.stable_sort}, whichever is faster - on typical input. ") +/** Same as {!List.sort} or {!List.stable_sort}, whichever is faster + on typical input. */ let fast_sort: (('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Same as {!List.sort}, but also remove duplicates. - @since 4.02.0 ") +/** Same as {!List.sort}, but also remove duplicates. + @since 4.02.0 */ let sort_uniq: (('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Merge two lists: +/** Merge two lists: Assuming that [l1] and [l2] are sorted according to the comparison function [cmp], [merge cmp l1 l2] will return a sorted list containing all the elements of [l1] and [l2]. If several elements compare equal, the elements of [l1] will be before the elements of [l2]. Not tail-recursive (sum of the lengths of the arguments). -") +*/ let merge: (('a, 'a) => int, list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/listLabels.resi b/jscomp/stdlib-406/listLabels.resi index cf6e45d91c..23b3ca9062 100644 --- a/jscomp/stdlib-406/listLabels.resi +++ b/jscomp/stdlib-406/listLabels.resi @@ -26,274 +26,274 @@ longer than about 10000 elements. ") -@ocaml.doc(" Return the length (number of elements) of the given list. ") +/** Return the length (number of elements) of the given list. */ let length: list<'a> => int -@ocaml.doc(" Return the first element of the given list. Raise - [Failure \"hd\"] if the list is empty. ") +/** Return the first element of the given list. Raise + [Failure \"hd\"] if the list is empty. */ let hd: list<'a> => 'a -@ocaml.doc(" Compare the lengths of two lists. [compare_lengths l1 l2] is +/** Compare the lengths of two lists. [compare_lengths l1 l2] is equivalent to [compare (length l1) (length l2)], except that the computation stops after itering on the shortest list. @since 4.05.0 - ") + */ let compare_lengths: (list<'a>, list<'b>) => int -@ocaml.doc(" Compare the length of a list to an integer. [compare_length_with l n] is +/** Compare the length of a list to an integer. [compare_length_with l n] is equivalent to [compare (length l) n], except that the computation stops after at most [n] iterations on the list. @since 4.05.0 -") +*/ let compare_length_with: (list<'a>, ~len: int) => int -@ocaml.doc(" [cons x xs] is [x :: xs] +/** [cons x xs] is [x :: xs] @since 4.05.0 -") +*/ let cons: ('a, list<'a>) => list<'a> -@ocaml.doc(" Return the given list without its first element. Raise - [Failure \"tl\"] if the list is empty. ") +/** Return the given list without its first element. Raise + [Failure \"tl\"] if the list is empty. */ let tl: list<'a> => list<'a> -@ocaml.doc(" Return the [n]-th element of the given list. +/** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. Raise [Failure \"nth\"] if the list is too short. - Raise [Invalid_argument \"List.nth\"] if [n] is negative. ") + Raise [Invalid_argument \"List.nth\"] if [n] is negative. */ let nth: (list<'a>, int) => 'a -@ocaml.doc(" Return the [n]-th element of the given list. +/** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. Return [None] if the list is too short. Raise [Invalid_argument \"List.nth\"] if [n] is negative. @since 4.05 -") +*/ let nth_opt: (list<'a>, int) => option<'a> -@ocaml.doc(" List reversal. ") +/** List reversal. */ let rev: list<'a> => list<'a> -@ocaml.doc(" [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. +/** [List.init len f] is [f 0; f 1; ...; f (len-1)], evaluated left to right. @raise Invalid_argument if [len < 0]. @since 4.06.0 -") +*/ let init: (~len: int, ~f: int => 'a) => list<'a> -@ocaml.doc(" Catenate two lists. Same function as the infix operator [@]. +/** Catenate two lists. Same function as the infix operator [@]. Not tail-recursive (length of the first argument). The [@] - operator is not tail-recursive either. ") + operator is not tail-recursive either. */ let append: (list<'a>, list<'a>) => list<'a> -@ocaml.doc(" [List.rev_append l1 l2] reverses [l1] and concatenates it with [l2]. +/** [List.rev_append l1 l2] reverses [l1] and concatenates it with [l2]. This is equivalent to [(]{!List.rev}[ l1) @ l2], but [rev_append] is - tail-recursive and more efficient. ") + tail-recursive and more efficient. */ let rev_append: (list<'a>, list<'a>) => list<'a> -@ocaml.doc(" Concatenate a list of lists. The elements of the argument are all +/** Concatenate a list of lists. The elements of the argument are all concatenated together (in the same order) to give the result. Not tail-recursive - (length of the argument + length of the longest sub-list). ") + (length of the argument + length of the longest sub-list). */ let concat: list> => list<'a> -@ocaml.doc(" Same as [concat]. Not tail-recursive - (length of the argument + length of the longest sub-list). ") +/** Same as [concat]. Not tail-recursive + (length of the argument + length of the longest sub-list). */ let flatten: list> => list<'a> @@ocaml.text(" {1 Iterators} ") -@ocaml.doc(" [List.iter f [a1; ...; an]] applies function [f] in turn to +/** [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an]. It is equivalent to - [begin f a1; f a2; ...; f an; () end]. ") + [begin f a1; f a2; ...; f an; () end]. */ let iter: (~f: 'a => unit, list<'a>) => unit -@ocaml.doc(" Same as {!List.iter}, but the function is applied to the index of +/** Same as {!List.iter}, but the function is applied to the index of the element as first argument (counting from 0), and the element itself as second argument. @since 4.00.0 -") +*/ let iteri: (~f: (int, 'a) => unit, list<'a>) => unit -@ocaml.doc(" [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], +/** [List.map f [a1; ...; an]] applies function [f] to [a1, ..., an], and builds the list [[f a1; ...; f an]] - with the results returned by [f]. Not tail-recursive. ") + with the results returned by [f]. Not tail-recursive. */ let map: (~f: 'a => 'b, list<'a>) => list<'b> -@ocaml.doc(" Same as {!List.map}, but the function is applied to the index of +/** Same as {!List.map}, but the function is applied to the index of the element as first argument (counting from 0), and the element itself as second argument. @since 4.00.0 -") +*/ let mapi: (~f: (int, 'a) => 'b, list<'a>) => list<'b> -@ocaml.doc(" [List.rev_map f l] gives the same result as +/** [List.rev_map f l] gives the same result as {!List.rev}[ (]{!List.map}[ f l)], but is tail-recursive and - more efficient. ") + more efficient. */ let rev_map: (~f: 'a => 'b, list<'a>) => list<'b> -@ocaml.doc(" [List.fold_left f a [b1; ...; bn]] is - [f (... (f (f a b1) b2) ...) bn]. ") +/** [List.fold_left f a [b1; ...; bn]] is + [f (... (f (f a b1) b2) ...) bn]. */ let fold_left: (~f: ('a, 'b) => 'a, ~init: 'a, list<'b>) => 'a -@ocaml.doc(" [List.fold_right f [a1; ...; an] b] is - [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. ") +/** [List.fold_right f [a1; ...; an] b] is + [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. */ let fold_right: (~f: ('a, 'b) => 'b, list<'a>, ~init: 'b) => 'b @@ocaml.text(" {1 Iterators on two lists} ") -@ocaml.doc(" [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn +/** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let iter2: (~f: ('a, 'b) => unit, list<'a>, list<'b>) => unit -@ocaml.doc(" [List.map2 f [a1; ...; an] [b1; ...; bn]] is +/** [List.map2 f [a1; ...; an] [b1; ...; bn]] is [[f a1 b1; ...; f an bn]]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. ") + to have different lengths. Not tail-recursive. */ let map2: (~f: ('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> -@ocaml.doc(" [List.rev_map2 f l1 l2] gives the same result as +/** [List.rev_map2 f l1 l2] gives the same result as {!List.rev}[ (]{!List.map2}[ f l1 l2)], but is tail-recursive and - more efficient. ") + more efficient. */ let rev_map2: (~f: ('a, 'b) => 'c, list<'a>, list<'b>) => list<'c> -@ocaml.doc(" [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is +/** [List.fold_left2 f a [b1; ...; bn] [c1; ...; cn]] is [f (... (f (f a b1 c1) b2 c2) ...) bn cn]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let fold_left2: (~f: ('a, 'b, 'c) => 'a, ~init: 'a, list<'b>, list<'c>) => 'a -@ocaml.doc(" [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is +/** [List.fold_right2 f [a1; ...; an] [b1; ...; bn] c] is [f a1 b1 (f a2 b2 (... (f an bn c) ...))]. Raise [Invalid_argument] if the two lists are determined - to have different lengths. Not tail-recursive. ") + to have different lengths. Not tail-recursive. */ let fold_right2: (~f: ('a, 'b, 'c) => 'c, list<'a>, list<'b>, ~init: 'c) => 'c @@ocaml.text(" {1 List scanning} ") -@ocaml.doc(" [for_all p [a1; ...; an]] checks if all elements of the list +/** [for_all p [a1; ...; an]] checks if all elements of the list satisfy the predicate [p]. That is, it returns - [(p a1) && (p a2) && ... && (p an)]. ") + [(p a1) && (p a2) && ... && (p an)]. */ let for_all: (~f: 'a => bool, list<'a>) => bool -@ocaml.doc(" [exists p [a1; ...; an]] checks if at least one element of +/** [exists p [a1; ...; an]] checks if at least one element of the list satisfies the predicate [p]. That is, it returns - [(p a1) || (p a2) || ... || (p an)]. ") + [(p a1) || (p a2) || ... || (p an)]. */ let exists: (~f: 'a => bool, list<'a>) => bool -@ocaml.doc(" Same as {!List.for_all}, but for a two-argument predicate. +/** Same as {!List.for_all}, but for a two-argument predicate. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let for_all2: (~f: ('a, 'b) => bool, list<'a>, list<'b>) => bool -@ocaml.doc(" Same as {!List.exists}, but for a two-argument predicate. +/** Same as {!List.exists}, but for a two-argument predicate. Raise [Invalid_argument] if the two lists are determined - to have different lengths. ") + to have different lengths. */ let exists2: (~f: ('a, 'b) => bool, list<'a>, list<'b>) => bool -@ocaml.doc(" [mem a l] is true if and only if [a] is equal - to an element of [l]. ") +/** [mem a l] is true if and only if [a] is equal + to an element of [l]. */ let mem: ('a, ~set: list<'a>) => bool -@ocaml.doc(" Same as {!List.mem}, but uses physical equality instead of structural - equality to compare list elements. ") +/** Same as {!List.mem}, but uses physical equality instead of structural + equality to compare list elements. */ let memq: ('a, ~set: list<'a>) => bool @@ocaml.text(" {1 List searching} ") -@ocaml.doc(" [find p l] returns the first element of the list [l] +/** [find p l] returns the first element of the list [l] that satisfies the predicate [p]. Raise [Not_found] if there is no value that satisfies [p] in the - list [l]. ") + list [l]. */ let find: (~f: 'a => bool, list<'a>) => 'a -@ocaml.doc(" [find p l] returns the first element of the list [l] +/** [find p l] returns the first element of the list [l] that satisfies the predicate [p]. Returns [None] if there is no value that satisfies [p] in the list [l]. - @since 4.05 ") + @since 4.05 */ let find_opt: (~f: 'a => bool, list<'a>) => option<'a> -@ocaml.doc(" [filter p l] returns all the elements of the list [l] +/** [filter p l] returns all the elements of the list [l] that satisfy the predicate [p]. The order of the elements - in the input list is preserved. ") + in the input list is preserved. */ let filter: (~f: 'a => bool, list<'a>) => list<'a> -@ocaml.doc(" [find_all] is another name for {!List.filter}. ") +/** [find_all] is another name for {!List.filter}. */ let find_all: (~f: 'a => bool, list<'a>) => list<'a> -@ocaml.doc(" [partition p l] returns a pair of lists [(l1, l2)], where +/** [partition p l] returns a pair of lists [(l1, l2)], where [l1] is the list of all the elements of [l] that satisfy the predicate [p], and [l2] is the list of all the elements of [l] that do not satisfy [p]. - The order of the elements in the input list is preserved. ") + The order of the elements in the input list is preserved. */ let partition: (~f: 'a => bool, list<'a>) => (list<'a>, list<'a>) @@ocaml.text(" {1 Association lists} ") -@ocaml.doc(" [assoc a l] returns the value associated with key [a] in the list of +/** [assoc a l] returns the value associated with key [a] in the list of pairs [l]. That is, [assoc a [ ...; (a,b); ...] = b] if [(a,b)] is the leftmost binding of [a] in list [l]. Raise [Not_found] if there is no value associated with [a] in the - list [l]. ") + list [l]. */ let assoc: ('a, list<('a, 'b)>) => 'b -@ocaml.doc(" [assoc_opt a l] returns the value associated with key [a] in the list of +/** [assoc_opt a l] returns the value associated with key [a] in the list of pairs [l]. That is, [assoc a [ ...; (a,b); ...] = b] if [(a,b)] is the leftmost binding of [a] in list [l]. Returns [None] if there is no value associated with [a] in the list [l]. @since 4.05 -") +*/ let assoc_opt: ('a, list<('a, 'b)>) => option<'b> -@ocaml.doc(" Same as {!List.assoc}, but uses physical equality instead of - structural equality to compare keys. ") +/** Same as {!List.assoc}, but uses physical equality instead of + structural equality to compare keys. */ let assq: ('a, list<('a, 'b)>) => 'b -@ocaml.doc(" Same as {!List.assoc_opt}, but uses physical equality instead of +/** Same as {!List.assoc_opt}, but uses physical equality instead of structural equality to compare keys. - @since 4.05.0 ") + @since 4.05.0 */ let assq_opt: ('a, list<('a, 'b)>) => option<'b> -@ocaml.doc(" Same as {!List.assoc}, but simply return true if a binding exists, - and false if no bindings exist for the given key. ") +/** Same as {!List.assoc}, but simply return true if a binding exists, + and false if no bindings exist for the given key. */ let mem_assoc: ('a, ~map: list<('a, 'b)>) => bool -@ocaml.doc(" Same as {!List.mem_assoc}, but uses physical equality instead of - structural equality to compare keys. ") +/** Same as {!List.mem_assoc}, but uses physical equality instead of + structural equality to compare keys. */ let mem_assq: ('a, ~map: list<('a, 'b)>) => bool -@ocaml.doc(" [remove_assoc a l] returns the list of +/** [remove_assoc a l] returns the list of pairs [l] without the first pair with key [a], if any. - Not tail-recursive. ") + Not tail-recursive. */ let remove_assoc: ('a, list<('a, 'b)>) => list<('a, 'b)> -@ocaml.doc(" Same as {!List.remove_assoc}, but uses physical equality instead - of structural equality to compare keys. Not tail-recursive. ") +/** Same as {!List.remove_assoc}, but uses physical equality instead + of structural equality to compare keys. Not tail-recursive. */ let remove_assq: ('a, list<('a, 'b)>) => list<('a, 'b)> @@ocaml.text(" {1 Lists of pairs} ") -@ocaml.doc(" Transform a list of pairs into a pair of lists: +/** Transform a list of pairs into a pair of lists: [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. Not tail-recursive. -") +*/ let split: list<('a, 'b)> => (list<'a>, list<'b>) -@ocaml.doc(" Transform a pair of lists into a list of pairs: +/** Transform a pair of lists into a list of pairs: [combine [a1; ...; an] [b1; ...; bn]] is [[(a1,b1); ...; (an,bn)]]. Raise [Invalid_argument] if the two lists - have different lengths. Not tail-recursive. ") + have different lengths. Not tail-recursive. */ let combine: (list<'a>, list<'b>) => list<('a, 'b)> @@ocaml.text(" {1 Sorting} ") -@ocaml.doc(" Sort a list in increasing order according to a comparison +/** Sort a list in increasing order according to a comparison function. The comparison function must return 0 if its arguments compare as equal, a positive integer if the first is greater, and a negative integer if the first is smaller (see Array.sort for @@ -306,32 +306,32 @@ let combine: (list<'a>, list<'b>) => list<('a, 'b)> The current implementation uses Merge Sort. It runs in constant heap space and logarithmic stack space. -") +*/ let sort: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Same as {!List.sort}, but the sorting algorithm is guaranteed to +/** Same as {!List.sort}, but the sorting algorithm is guaranteed to be stable (i.e. elements that compare equal are kept in their original order) . The current implementation uses Merge Sort. It runs in constant heap space and logarithmic stack space. -") +*/ let stable_sort: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Same as {!List.sort} or {!List.stable_sort}, whichever is - faster on typical input. ") +/** Same as {!List.sort} or {!List.stable_sort}, whichever is + faster on typical input. */ let fast_sort: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Same as {!List.sort}, but also remove duplicates. - @since 4.03.0 ") +/** Same as {!List.sort}, but also remove duplicates. + @since 4.03.0 */ let sort_uniq: (~cmp: ('a, 'a) => int, list<'a>) => list<'a> -@ocaml.doc(" Merge two lists: +/** Merge two lists: Assuming that [l1] and [l2] are sorted according to the comparison function [cmp], [merge cmp l1 l2] will return a sorted list containing all the elements of [l1] and [l2]. If several elements compare equal, the elements of [l1] will be before the elements of [l2]. Not tail-recursive (sum of the lengths of the arguments). -") +*/ let merge: (~cmp: ('a, 'a) => int, list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/map.resi b/jscomp/stdlib-406/map.resi index 404726fc6e..74288e6db3 100644 --- a/jscomp/stdlib-406/map.resi +++ b/jscomp/stdlib-406/map.resi @@ -43,49 +43,49 @@ values so its type is [string PairsMap.t]. ") -@ocaml.doc(" Input signature of the functor {!Map.Make}. ") +/** Input signature of the functor {!Map.Make}. */ module type OrderedType = { - @ocaml.doc(" The type of the map keys. ") + /** The type of the map keys. */ type t - @ocaml.doc(" A total ordering function over the keys. + /** A total ordering function over the keys. This is a two-argument function [f] such that [f e1 e2] is zero if the keys [e1] and [e2] are equal, [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. ") + comparison function {!Pervasives.compare}. */ let compare: (t, t) => int } -@ocaml.doc(" Output signature of the functor {!Map.Make}. ") +/** Output signature of the functor {!Map.Make}. */ module type S = { - @ocaml.doc(" The type of the map keys. ") + /** The type of the map keys. */ type key - @ocaml.doc(" The type of maps from type [key] to type ['a]. ") + /** The type of maps from type [key] to type ['a]. */ type t<+'a> - @ocaml.doc(" The empty map. ") + /** The empty map. */ let empty: t<'a> - @ocaml.doc(" Test whether a map is empty or not. ") + /** Test whether a map is empty or not. */ let is_empty: t<'a> => bool - @ocaml.doc(" [mem x m] returns [true] if [m] contains a binding for [x], - and [false] otherwise. ") + /** [mem x m] returns [true] if [m] contains a binding for [x], + and [false] otherwise. */ let mem: (key, t<'a>) => bool - @ocaml.doc(" [add x y m] returns a map containing the same bindings as + /** [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m] to a value that is physically equal to [y], [m] is returned unchanged (the result of the function is then physically equal to [m]). Otherwise, the previous binding of [x] in [m] disappears. - @before 4.03 Physical equality was not ensured. ") + @before 4.03 Physical equality was not ensured. */ let add: (key, 'a, t<'a>) => t<'a> - @ocaml.doc(" [update x f m] returns a map containing the same bindings as + /** [update x f m] returns a map containing the same bindings as [m], except for the binding of [x]. Depending on the value of [y] where [y] is [f (find_opt x m)], the binding of [x] is added, removed or updated. If [y] is [None], the binding is @@ -95,33 +95,33 @@ module type S = { is returned unchanged (the result of the function is then physically equal to [m]). @since 4.06.0 - ") + */ let update: (key, option<'a> => option<'a>, t<'a>) => t<'a> - @ocaml.doc(" [singleton x y] returns the one-element map that contains a binding [y] + /** [singleton x y] returns the one-element map that contains a binding [y] for [x]. @since 3.12.0 - ") + */ let singleton: (key, 'a) => t<'a> - @ocaml.doc(" [remove x m] returns a map containing the same bindings as + /** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. If [x] was not in [m], [m] is returned unchanged (the result of the function is then physically equal to [m]). - @before 4.03 Physical equality was not ensured. ") + @before 4.03 Physical equality was not ensured. */ let remove: (key, t<'a>) => t<'a> - @ocaml.doc(" [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] + /** [merge f m1 m2] computes a map whose keys is a subset of keys of [m1] and of [m2]. The presence of each such binding, and the corresponding value, is determined with the function [f]. In terms of the [find_opt] operation, we have [find_opt x (merge f m1 m2) = f (find_opt x m1) (find_opt x m2)] for any key [x], provided that [f None None = None]. @since 3.12.0 - ") + */ let merge: ((key, option<'a>, option<'b>) => option<'c>, t<'a>, t<'b>) => t<'c> - @ocaml.doc(" [union f m1 m2] computes a map whose keys is the union of keys + /** [union f m1 m2] computes a map whose keys is the union of keys of [m1] and of [m2]. When the same binding is defined in both arguments, the function [f] is used to combine them. This is a special case of [merge]: [union f m1 m2] is equivalent @@ -132,113 +132,113 @@ module type S = { - [f' (Some v1) (Some v2) = f v1 v2] @since 4.03.0 - ") + */ let union: ((key, 'a, 'a) => option<'a>, t<'a>, t<'a>) => t<'a> - @ocaml.doc(" Total ordering between maps. The first argument is a total ordering - used to compare data associated with equal keys in the two maps. ") + /** Total ordering between maps. The first argument is a total ordering + used to compare data associated with equal keys in the two maps. */ let compare: (('a, 'a) => int, t<'a>, t<'a>) => int - @ocaml.doc(" [equal cmp m1 m2] tests whether the maps [m1] and [m2] are + /** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare - the data associated with the keys. ") + the data associated with the keys. */ let equal: (('a, 'a) => bool, t<'a>, t<'a>) => bool - @ocaml.doc(" [iter f m] applies [f] to all bindings in map [m]. + /** [iter f m] applies [f] to all bindings in map [m]. [f] receives the key as first argument, and the associated value as second argument. The bindings are passed to [f] in increasing - order with respect to the ordering over the type of the keys. ") + order with respect to the ordering over the type of the keys. */ let iter: ((key, 'a) => unit, t<'a>) => unit - @ocaml.doc(" [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], + /** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], where [k1 ... kN] are the keys of all bindings in [m] - (in increasing order), and [d1 ... dN] are the associated data. ") + (in increasing order), and [d1 ... dN] are the associated data. */ let fold: ((key, 'a, 'b) => 'b, t<'a>, 'b) => 'b - @ocaml.doc(" [for_all p m] checks if all the bindings of the map + /** [for_all p m] checks if all the bindings of the map satisfy the predicate [p]. @since 3.12.0 - ") + */ let for_all: ((key, 'a) => bool, t<'a>) => bool - @ocaml.doc(" [exists p m] checks if at least one binding of the map + /** [exists p m] checks if at least one binding of the map satisfies the predicate [p]. @since 3.12.0 - ") + */ let exists: ((key, 'a) => bool, t<'a>) => bool - @ocaml.doc(" [filter p m] returns the map with all the bindings in [m] + /** [filter p m] returns the map with all the bindings in [m] that satisfy predicate [p]. If [p] satisfies every binding in [m], [m] is returned unchanged (the result of the function is then physically equal to [m]) @since 3.12.0 @before 4.03 Physical equality was not ensured. - ") + */ let filter: ((key, 'a) => bool, t<'a>) => t<'a> - @ocaml.doc(" [partition p m] returns a pair of maps [(m1, m2)], where + /** [partition p m] returns a pair of maps [(m1, m2)], where [m1] contains all the bindings of [s] that satisfy the predicate [p], and [m2] is the map with all the bindings of [s] that do not satisfy [p]. @since 3.12.0 - ") + */ let partition: ((key, 'a) => bool, t<'a>) => (t<'a>, t<'a>) - @ocaml.doc(" Return the number of bindings of a map. + /** Return the number of bindings of a map. @since 3.12.0 - ") + */ let cardinal: t<'a> => int - @ocaml.doc(" Return the list of all bindings of the given map. + /** Return the list of all bindings of the given map. The returned list is sorted in increasing order with respect to the ordering [Ord.compare], where [Ord] is the argument given to {!Map.Make}. @since 3.12.0 - ") + */ let bindings: t<'a> => list<(key, 'a)> - @ocaml.doc(" Return the smallest binding of the given map + /** Return the smallest binding of the given map (with respect to the [Ord.compare] ordering), or raise [Not_found] if the map is empty. @since 3.12.0 - ") + */ let min_binding: t<'a> => (key, 'a) - @ocaml.doc(" Return the smallest binding of the given map + /** Return the smallest binding of the given map (with respect to the [Ord.compare] ordering), or [None] if the map is empty. @since 4.05 - ") + */ let min_binding_opt: t<'a> => option<(key, 'a)> - @ocaml.doc(" Same as {!Map.S.min_binding}, but returns the largest binding + /** Same as {!Map.S.min_binding}, but returns the largest binding of the given map. @since 3.12.0 - ") + */ let max_binding: t<'a> => (key, 'a) - @ocaml.doc(" Same as {!Map.S.min_binding_opt}, but returns the largest binding + /** Same as {!Map.S.min_binding_opt}, but returns the largest binding of the given map. @since 4.05 - ") + */ let max_binding_opt: t<'a> => option<(key, 'a)> - @ocaml.doc(" Return one binding of the given map, or raise [Not_found] if + /** Return one binding of the given map, or raise [Not_found] if the map is empty. Which binding is chosen is unspecified, but equal bindings will be chosen for equal maps. @since 3.12.0 - ") + */ let choose: t<'a> => (key, 'a) - @ocaml.doc(" Return one binding of the given map, or [None] if + /** Return one binding of the given map, or [None] if the map is empty. Which binding is chosen is unspecified, but equal bindings will be chosen for equal maps. @since 4.05 - ") + */ let choose_opt: t<'a> => option<(key, 'a)> - @ocaml.doc(" [split x m] returns a triple [(l, data, r)], where + /** [split x m] returns a triple [(l, data, r)], where [l] is the map with all the bindings of [m] whose key is strictly less than [x]; [r] is the map with all the bindings of [m] whose key @@ -246,20 +246,20 @@ module type S = { [data] is [None] if [m] contains no binding for [x], or [Some v] if [m] binds [v] to [x]. @since 3.12.0 - ") + */ let split: (key, t<'a>) => (t<'a>, option<'a>, t<'a>) - @ocaml.doc(" [find x m] returns the current binding of [x] in [m], - or raises [Not_found] if no such binding exists. ") + /** [find x m] returns the current binding of [x] in [m], + or raises [Not_found] if no such binding exists. */ let find: (key, t<'a>) => 'a - @ocaml.doc(" [find_opt x m] returns [Some v] if the current binding of [x] + /** [find_opt x m] returns [Some v] if the current binding of [x] in [m] is [v], or [None] if no such binding exists. @since 4.05 - ") + */ let find_opt: (key, t<'a>) => option<'a> - @ocaml.doc(" [find_first f m], where [f] is a monotonically increasing function, + /** [find_first f m], where [f] is a monotonically increasing function, returns the binding of [m] with the lowest key [k] such that [f k], or raises [Not_found] if no such key exists. @@ -269,42 +269,42 @@ module type S = { element of [m]. @since 4.05 - ") + */ let find_first: (key => bool, t<'a>) => (key, 'a) - @ocaml.doc(" [find_first_opt f m], where [f] is a monotonically increasing function, + /** [find_first_opt f m], where [f] is a monotonically increasing function, returns an option containing the binding of [m] with the lowest key [k] such that [f k], or [None] if no such key exists. @since 4.05 - ") + */ let find_first_opt: (key => bool, t<'a>) => option<(key, 'a)> - @ocaml.doc(" [find_last f m], where [f] is a monotonically decreasing function, + /** [find_last f m], where [f] is a monotonically decreasing function, returns the binding of [m] with the highest key [k] such that [f k], or raises [Not_found] if no such key exists. @since 4.05 - ") + */ let find_last: (key => bool, t<'a>) => (key, 'a) - @ocaml.doc(" [find_last_opt f m], where [f] is a monotonically decreasing function, + /** [find_last_opt f m], where [f] is a monotonically decreasing function, returns an option containing the binding of [m] with the highest key [k] such that [f k], or [None] if no such key exists. @since 4.05 - ") + */ let find_last_opt: (key => bool, t<'a>) => option<(key, 'a)> - @ocaml.doc(" [map f m] returns a map with same domain as [m], where the + /** [map f m] returns a map with same domain as [m], where the associated value [a] of all bindings of [m] has been replaced by the result of the application of [f] to [a]. The bindings are passed to [f] in increasing order - with respect to the ordering over the type of the keys. ") + with respect to the ordering over the type of the keys. */ let map: ('a => 'b, t<'a>) => t<'b> - @ocaml.doc(" Same as {!Map.S.map}, but the function receives as arguments both the - key and the associated value for each binding of the map. ") + /** Same as {!Map.S.map}, but the function receives as arguments both the + key and the associated value for each binding of the map. */ let mapi: ((key, 'a) => 'b, t<'a>) => t<'b> } -@ocaml.doc(" Functor building an implementation of the map structure - given a totally ordered type. ") +/** Functor building an implementation of the map structure + given a totally ordered type. */ module Make: (Ord: OrderedType) => (S with type key = Ord.t) diff --git a/jscomp/stdlib-406/obj.resi b/jscomp/stdlib-406/obj.resi index fd1192ef5d..cfc78accbe 100644 --- a/jscomp/stdlib-406/obj.resi +++ b/jscomp/stdlib-406/obj.resi @@ -38,7 +38,7 @@ external size: t => int = "#obj_length" external field: (t, int) => t = "%obj_field" -@ocaml.doc(" When using flambda: +/** When using flambda: [set_field] MUST NOT be called on immutable blocks. (Blocks allocated in C stubs, or with [new_block] below, are always considered mutable.) @@ -47,6 +47,6 @@ external field: (t, int) => t = "%obj_field" [set_field] et al can be made safe by first wrapping the block in {!Sys.opaque_identity}, so any information about its contents will not be propagated. -") +*/ external set_field: (t, int, t) => unit = "%obj_set_field" external dup: t => t = "?obj_dup" diff --git a/jscomp/stdlib-406/parsing.resi b/jscomp/stdlib-406/parsing.resi index d1d1dacbb9..afe853bff6 100644 --- a/jscomp/stdlib-406/parsing.resi +++ b/jscomp/stdlib-406/parsing.resi @@ -17,58 +17,58 @@ " The run-time library for parsers generated by [ocamlyacc]. " ) -@ocaml.doc(" [symbol_start] and {!Parsing.symbol_end} are to be called in the +/** [symbol_start] and {!Parsing.symbol_end} are to be called in the action part of a grammar rule only. They return the offset of the string that matches the left-hand side of the rule: [symbol_start()] returns the offset of the first character; [symbol_end()] returns the offset after the last character. The first character in a file is at - offset 0. ") + offset 0. */ let symbol_start: unit => int -@ocaml.doc(" See {!Parsing.symbol_start}. ") +/** See {!Parsing.symbol_start}. */ let symbol_end: unit => int -@ocaml.doc(" Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but +/** Same as {!Parsing.symbol_start} and {!Parsing.symbol_end}, but return the offset of the string matching the [n]th item on the right-hand side of the rule, where [n] is the integer parameter - to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. ") + to [rhs_start] and [rhs_end]. [n] is 1 for the leftmost item. */ let rhs_start: int => int -@ocaml.doc(" See {!Parsing.rhs_start}. ") +/** See {!Parsing.rhs_start}. */ let rhs_end: int => int -@ocaml.doc(" Same as [symbol_start], but return a [position] instead of an offset. ") +/** Same as [symbol_start], but return a [position] instead of an offset. */ let symbol_start_pos: unit => Lexing.position -@ocaml.doc(" Same as [symbol_end], but return a [position] instead of an offset. ") +/** Same as [symbol_end], but return a [position] instead of an offset. */ let symbol_end_pos: unit => Lexing.position -@ocaml.doc(" Same as [rhs_start], but return a [position] instead of an offset. ") +/** Same as [rhs_start], but return a [position] instead of an offset. */ let rhs_start_pos: int => Lexing.position -@ocaml.doc(" Same as [rhs_end], but return a [position] instead of an offset. ") +/** Same as [rhs_end], but return a [position] instead of an offset. */ let rhs_end_pos: int => Lexing.position -@ocaml.doc(" Empty the parser stack. Call it just after a parsing function +/** Empty the parser stack. Call it just after a parsing function has returned, to remove all pointers from the parser stack to structures that were built by semantic actions during parsing. This is optional, but lowers the memory requirements of the - programs. ") + programs. */ let clear_parser: unit => unit -@ocaml.doc(" Raised when a parser encounters a syntax error. +/** Raised when a parser encounters a syntax error. Can also be raised from the action part of a grammar rule, - to initiate error recovery. ") + to initiate error recovery. */ exception Parse_error -@ocaml.doc(" Control debugging support for [ocamlyacc]-generated parsers. +/** Control debugging support for [ocamlyacc]-generated parsers. After [Parsing.set_trace true], the pushdown automaton that executes the parsers prints a trace of its actions (reading a token, shifting a state, reducing by a rule) on standard output. [Parsing.set_trace false] turns this debugging trace off. The boolean returned is the previous state of the trace flag. @since 3.11.0 -") +*/ let set_trace: bool => bool @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/queue.resi b/jscomp/stdlib-406/queue.resi index 84a9ef2066..0a8388f233 100644 --- a/jscomp/stdlib-406/queue.resi +++ b/jscomp/stdlib-406/queue.resi @@ -22,59 +22,58 @@ Failure to do so can lead to a crash. ") -@ocaml.doc(" The type of queues containing elements of type ['a]. ") +/** The type of queues containing elements of type ['a]. */ type t<'a> -@ocaml.doc(" Raised when {!Queue.take} or {!Queue.peek} is applied to an empty queue. ") -exception Empty +/** Raised when {!Queue.take} or {!Queue.peek} is applied to an empty queue. */ exception Empty -@ocaml.doc(" Return a new queue, initially empty. ") +/** Return a new queue, initially empty. */ let create: unit => t<'a> -@ocaml.doc(" [add x q] adds the element [x] at the end of the queue [q]. ") +/** [add x q] adds the element [x] at the end of the queue [q]. */ let add: ('a, t<'a>) => unit -@ocaml.doc(" [push] is a synonym for [add]. ") +/** [push] is a synonym for [add]. */ let push: ('a, t<'a>) => unit -@ocaml.doc(" [take q] removes and returns the first element in queue [q], - or raises {!Empty} if the queue is empty. ") +/** [take q] removes and returns the first element in queue [q], + or raises {!Empty} if the queue is empty. */ let take: t<'a> => 'a -@ocaml.doc(" [pop] is a synonym for [take]. ") +/** [pop] is a synonym for [take]. */ let pop: t<'a> => 'a -@ocaml.doc(" [peek q] returns the first element in queue [q], without removing - it from the queue, or raises {!Empty} if the queue is empty. ") +/** [peek q] returns the first element in queue [q], without removing + it from the queue, or raises {!Empty} if the queue is empty. */ let peek: t<'a> => 'a -@ocaml.doc(" [top] is a synonym for [peek]. ") +/** [top] is a synonym for [peek]. */ let top: t<'a> => 'a -@ocaml.doc(" Discard all elements from a queue. ") +/** Discard all elements from a queue. */ let clear: t<'a> => unit -@ocaml.doc(" Return a copy of the given queue. ") +/** Return a copy of the given queue. */ let copy: t<'a> => t<'a> -@ocaml.doc(" Return [true] if the given queue is empty, [false] otherwise. ") +/** Return [true] if the given queue is empty, [false] otherwise. */ let is_empty: t<'a> => bool -@ocaml.doc(" Return the number of elements in a queue. ") +/** Return the number of elements in a queue. */ let length: t<'a> => int -@ocaml.doc(" [iter f q] applies [f] in turn to all elements of [q], +/** [iter f q] applies [f] in turn to all elements of [q], from the least recently entered to the most recently entered. - The queue itself is unchanged. ") + The queue itself is unchanged. */ let iter: ('a => unit, t<'a>) => unit -@ocaml.doc(" [fold f accu q] is equivalent to [List.fold_left f accu l], +/** [fold f accu q] is equivalent to [List.fold_left f accu l], where [l] is the list of [q]'s elements. The queue remains - unchanged. ") + unchanged. */ let fold: (('b, 'a) => 'b, 'b, t<'a>) => 'b -@ocaml.doc(" [transfer q1 q2] adds all of [q1]'s elements at the end of +/** [transfer q1 q2] adds all of [q1]'s elements at the end of the queue [q2], then clears [q1]. It is equivalent to the sequence [iter (fun x -> add x q2) q1; clear q1], but runs - in constant time. ") + in constant time. */ let transfer: (t<'a>, t<'a>) => unit diff --git a/jscomp/stdlib-406/random.resi b/jscomp/stdlib-406/random.resi index 790887f524..718c789d1b 100644 --- a/jscomp/stdlib-406/random.resi +++ b/jscomp/stdlib-406/random.resi @@ -19,46 +19,46 @@ @@ocaml.text(" {1 Basic functions} ") -@ocaml.doc(" Initialize the generator, using the argument as a seed. - The same seed will always yield the same sequence of numbers. ") +/** Initialize the generator, using the argument as a seed. + The same seed will always yield the same sequence of numbers. */ let init: int => unit -@ocaml.doc(" Same as {!Random.init} but takes more data as seed. ") +/** Same as {!Random.init} but takes more data as seed. */ let full_init: array => unit -@ocaml.doc(" Initialize the generator with a random seed chosen +/** 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). ") + parameters (current time, process IDs). */ let self_init: unit => unit -@ocaml.doc(" Return 30 random bits in a nonnegative integer. +/** 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 -@ocaml.doc(" [Random.int bound] returns a random integer between 0 (inclusive) +/** [Random.int bound] returns a random integer between 0 (inclusive) and [bound] (exclusive). [bound] must be greater than 0 and less - than 2{^30}. ") + than 2{^30}. */ let int: int => int -@ocaml.doc(" [Random.int32 bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0. ") +/** [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 -@ocaml.doc(" [Random.int64 bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be greater than 0. ") +/** [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 -@ocaml.doc(" [Random.float bound] returns a random floating-point number +/** [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. ") + the result is 0. */ let float: float => float -@ocaml.doc(" [Random.bool ()] returns [true] or [false] with probability 0.5 each. ") +/** [Random.bool ()] returns [true] or [false] with probability 0.5 each. */ let bool: unit => bool @@ocaml.text(" {1 Advanced functions} ") @@ -71,17 +71,17 @@ let bool: unit => bool ") module State: { - @ocaml.doc(" The type of PRNG states. ") + /** The type of PRNG states. */ type t - @ocaml.doc(" Create a new state and initialize it with the given seed. ") + /** Create a new state and initialize it with the given seed. */ let make: array => t - @ocaml.doc(" Create a new state and initialize it with a system-dependent - low-entropy seed. ") + /** Create a new state and initialize it with a system-dependent + low-entropy seed. */ let make_self_init: unit => t - @ocaml.doc(" Return a copy of the given state. ") + /** Return a copy of the given state. */ let copy: t => t let bits: t => int @@ -89,14 +89,14 @@ module State: { let int32: (t, Int32.t) => Int32.t let int64: (t, Int64.t) => Int64.t let float: (t, float) => float - @ocaml.doc(" These functions are the same as the basic functions, except that they + /** 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 } -@ocaml.doc(" Return the current state of the generator used by the basic functions. ") +/** Return the current state of the generator used by the basic functions. */ let get_state: unit => State.t -@ocaml.doc(" Set the state of the generator used by the basic functions. ") +/** Set the state of the generator used by the basic functions. */ let set_state: State.t => unit diff --git a/jscomp/stdlib-406/set.resi b/jscomp/stdlib-406/set.resi index 5620e66b33..b731eb6bba 100644 --- a/jscomp/stdlib-406/set.resi +++ b/jscomp/stdlib-406/set.resi @@ -44,80 +44,80 @@ of sets of [int * int]. ") -@ocaml.doc(" Input signature of the functor {!Set.Make}. ") +/** Input signature of the functor {!Set.Make}. */ module type OrderedType = { - @ocaml.doc(" The type of the set elements. ") + /** The type of the set elements. */ type t - @ocaml.doc(" A total ordering function over the set elements. + /** A total ordering function over the set elements. This is a two-argument function [f] such that [f e1 e2] is zero if the elements [e1] and [e2] are equal, [f e1 e2] is strictly negative if [e1] is smaller than [e2], and [f e1 e2] is strictly positive if [e1] is greater than [e2]. Example: a suitable ordering function is the generic structural - comparison function {!Pervasives.compare}. ") + comparison function {!Pervasives.compare}. */ let compare: (t, t) => int } -@ocaml.doc(" Output signature of the functor {!Set.Make}. ") +/** Output signature of the functor {!Set.Make}. */ module type S = { - @ocaml.doc(" The type of the set elements. ") + /** The type of the set elements. */ type elt - @ocaml.doc(" The type of sets. ") + /** The type of sets. */ type t - @ocaml.doc(" The empty set. ") + /** The empty set. */ let empty: t - @ocaml.doc(" Test whether a set is empty or not. ") + /** Test whether a set is empty or not. */ let is_empty: t => bool - @ocaml.doc(" [mem x s] tests whether [x] belongs to the set [s]. ") + /** [mem x s] tests whether [x] belongs to the set [s]. */ let mem: (elt, t) => bool - @ocaml.doc(" [add x s] returns a set containing all elements of [s], + /** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged (the result of the function is then physically equal to [s]). - @before 4.03 Physical equality was not ensured. ") + @before 4.03 Physical equality was not ensured. */ let add: (elt, t) => t - @ocaml.doc(" [singleton x] returns the one-element set containing only [x]. ") + /** [singleton x] returns the one-element set containing only [x]. */ let singleton: elt => t - @ocaml.doc(" [remove x s] returns a set containing all elements of [s], + /** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged (the result of the function is then physically equal to [s]). - @before 4.03 Physical equality was not ensured. ") + @before 4.03 Physical equality was not ensured. */ let remove: (elt, t) => t - @ocaml.doc(" Set union. ") + /** Set union. */ let union: (t, t) => t - @ocaml.doc(" Set intersection. ") + /** Set intersection. */ let inter: (t, t) => t - @ocaml.doc(" Set difference. ") + /** Set difference. */ let diff: (t, t) => t - @ocaml.doc(" Total ordering between sets. Can be used as the ordering function - for doing sets of sets. ") + /** Total ordering between sets. Can be used as the ordering function + for doing sets of sets. */ let compare: (t, t) => int - @ocaml.doc(" [equal s1 s2] tests whether the sets [s1] and [s2] are - equal, that is, contain equal elements. ") + /** [equal s1 s2] tests whether the sets [s1] and [s2] are + equal, that is, contain equal elements. */ let equal: (t, t) => bool - @ocaml.doc(" [subset s1 s2] tests whether the set [s1] is a subset of - the set [s2]. ") + /** [subset s1 s2] tests whether the set [s1] is a subset of + the set [s2]. */ let subset: (t, t) => bool - @ocaml.doc(" [iter f s] applies [f] in turn to all elements of [s]. + /** [iter f s] applies [f] in turn to all elements of [s]. The elements of [s] are presented to [f] in increasing order - with respect to the ordering over the type of the elements. ") + with respect to the ordering over the type of the elements. */ let iter: (elt => unit, t) => unit - @ocaml.doc(" [map f s] is the set whose elements are [f a0],[f a1]... [f + /** [map f s] is the set whose elements are [f a0],[f a1]... [f aN], where [a0],[a1]...[aN] are the elements of [s]. The elements are passed to [f] in increasing order @@ -126,99 +126,99 @@ module type S = { If no element of [s] is changed by [f], [s] is returned unchanged. (If each output of [f] is physically equal to its input, the returned set is physically equal to [s].) - @since 4.04.0 ") + @since 4.04.0 */ let map: (elt => elt, t) => t - @ocaml.doc(" [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], - where [x1 ... xN] are the elements of [s], in increasing order. ") + /** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], + where [x1 ... xN] are the elements of [s], in increasing order. */ let fold: ((elt, 'a) => 'a, t, 'a) => 'a - @ocaml.doc(" [for_all p s] checks if all elements of the set - satisfy the predicate [p]. ") + /** [for_all p s] checks if all elements of the set + satisfy the predicate [p]. */ let for_all: (elt => bool, t) => bool - @ocaml.doc(" [exists p s] checks if at least one element of - the set satisfies the predicate [p]. ") + /** [exists p s] checks if at least one element of + the set satisfies the predicate [p]. */ let exists: (elt => bool, t) => bool - @ocaml.doc(" [filter p s] returns the set of all elements in [s] + /** [filter p s] returns the set of all elements in [s] that satisfy predicate [p]. If [p] satisfies every element in [s], [s] is returned unchanged (the result of the function is then physically equal to [s]). - @before 4.03 Physical equality was not ensured.") + @before 4.03 Physical equality was not ensured.*/ let filter: (elt => bool, t) => t - @ocaml.doc(" [partition p s] returns a pair of sets [(s1, s2)], where + /** [partition p s] returns a pair of sets [(s1, s2)], where [s1] is the set of all the elements of [s] that satisfy the predicate [p], and [s2] is the set of all the elements of - [s] that do not satisfy [p]. ") + [s] that do not satisfy [p]. */ let partition: (elt => bool, t) => (t, t) - @ocaml.doc(" Return the number of elements of a set. ") + /** Return the number of elements of a set. */ let cardinal: t => int - @ocaml.doc(" Return the list of all elements of the given set. + /** Return the list of all elements of the given set. The returned list is sorted in increasing order with respect to the ordering [Ord.compare], where [Ord] is the argument - given to {!Set.Make}. ") + given to {!Set.Make}. */ let elements: t => list - @ocaml.doc(" Return the smallest element of the given set + /** Return the smallest element of the given set (with respect to the [Ord.compare] ordering), or raise - [Not_found] if the set is empty. ") + [Not_found] if the set is empty. */ let min_elt: t => elt - @ocaml.doc(" Return the smallest element of the given set + /** Return the smallest element of the given set (with respect to the [Ord.compare] ordering), or [None] if the set is empty. @since 4.05 - ") + */ let min_elt_opt: t => option - @ocaml.doc(" Same as {!Set.S.min_elt}, but returns the largest element of the - given set. ") + /** Same as {!Set.S.min_elt}, but returns the largest element of the + given set. */ let max_elt: t => elt - @ocaml.doc(" Same as {!Set.S.min_elt_opt}, but returns the largest element of the + /** Same as {!Set.S.min_elt_opt}, but returns the largest element of the given set. @since 4.05 - ") + */ let max_elt_opt: t => option - @ocaml.doc(" Return one element of the given set, or raise [Not_found] if + /** Return one element of the given set, or raise [Not_found] if the set is empty. Which element is chosen is unspecified, - but equal elements will be chosen for equal sets. ") + but equal elements will be chosen for equal sets. */ let choose: t => elt - @ocaml.doc(" Return one element of the given set, or [None] if + /** Return one element of the given set, or [None] if the set is empty. Which element is chosen is unspecified, but equal elements will be chosen for equal sets. @since 4.05 - ") + */ let choose_opt: t => option - @ocaml.doc(" [split x s] returns a triple [(l, present, r)], where + /** [split x s] returns a triple [(l, present, r)], where [l] is the set of elements of [s] that are strictly less than [x]; [r] is the set of elements of [s] that are strictly greater than [x]; [present] is [false] if [s] contains no element equal to [x], - or [true] if [s] contains an element equal to [x]. ") + or [true] if [s] contains an element equal to [x]. */ let split: (elt, t) => (t, bool, t) - @ocaml.doc(" [find x s] returns the element of [s] equal to [x] (according + /** [find x s] returns the element of [s] equal to [x] (according to [Ord.compare]), or raise [Not_found] if no such element exists. - @since 4.01.0 ") + @since 4.01.0 */ let find: (elt, t) => elt - @ocaml.doc(" [find_opt x s] returns the element of [s] equal to [x] (according + /** [find_opt x s] returns the element of [s] equal to [x] (according to [Ord.compare]), or [None] if no such element exists. - @since 4.05 ") + @since 4.05 */ let find_opt: (elt, t) => option - @ocaml.doc(" [find_first f s], where [f] is a monotonically increasing function, + /** [find_first f s], where [f] is a monotonically increasing function, returns the lowest element [e] of [s] such that [f e], or raises [Not_found] if no such element exists. @@ -228,37 +228,37 @@ module type S = { [s]. @since 4.05 - ") + */ let find_first: (elt => bool, t) => elt - @ocaml.doc(" [find_first_opt f s], where [f] is a monotonically increasing function, + /** [find_first_opt f s], where [f] is a monotonically increasing function, returns an option containing the lowest element [e] of [s] such that [f e], or [None] if no such element exists. @since 4.05 - ") + */ let find_first_opt: (elt => bool, t) => option - @ocaml.doc(" [find_last f s], where [f] is a monotonically decreasing function, + /** [find_last f s], where [f] is a monotonically decreasing function, returns the highest element [e] of [s] such that [f e], or raises [Not_found] if no such element exists. @since 4.05 - ") + */ let find_last: (elt => bool, t) => elt - @ocaml.doc(" [find_last_opt f s], where [f] is a monotonically decreasing function, + /** [find_last_opt f s], where [f] is a monotonically decreasing function, returns an option containing the highest element [e] of [s] such that [f e], or [None] if no such element exists. @since 4.05 - ") + */ let find_last_opt: (elt => bool, t) => option - @ocaml.doc(" [of_list l] creates a set from a list of elements. + /** [of_list l] creates a set from a list of elements. This is usually more efficient than folding [add] over the list, except perhaps for lists with many duplicated elements. - @since 4.02.0 ") + @since 4.02.0 */ let of_list: list => t } -@ocaml.doc(" Functor building an implementation of the set structure - given a totally ordered type. ") +/** Functor building an implementation of the set structure + given a totally ordered type. */ module Make: (Ord: OrderedType) => (S with type elt = Ord.t) diff --git a/jscomp/stdlib-406/sort.resi b/jscomp/stdlib-406/sort.resi index 7b76e63d90..6944a7e835 100644 --- a/jscomp/stdlib-406/sort.resi +++ b/jscomp/stdlib-406/sort.resi @@ -22,23 +22,23 @@ ") @ocaml.deprecated("Use List.sort instead.") -@ocaml.doc(" Sort a list in increasing order according to an ordering predicate. +/** Sort a list in increasing order according to an ordering predicate. The predicate should return [true] if its first argument is - less than or equal to its second argument. ") + less than or equal to its second argument. */ let list: (('a, 'a) => bool, list<'a>) => list<'a> @ocaml.deprecated("Use Array.sort instead.") -@ocaml.doc(" Sort an array in increasing order according to an +/** Sort an array in increasing order according to an ordering predicate. The predicate should return [true] if its first argument is less than or equal to its second argument. - The array is sorted in place. ") + The array is sorted in place. */ let array: (('a, 'a) => bool, array<'a>) => unit @ocaml.deprecated("Use List.merge instead.") -@ocaml.doc(" Merge two lists according to the given predicate. +/** Merge two lists according to the given predicate. Assuming the two argument lists are sorted according to the predicate, [merge] returns a sorted list containing the elements from the two lists. The behavior is undefined if the two - argument lists were not sorted. ") + argument lists were not sorted. */ let merge: (('a, 'a) => bool, list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/stack.resi b/jscomp/stdlib-406/stack.resi index 551d05d3c9..9fc5e44625 100644 --- a/jscomp/stdlib-406/stack.resi +++ b/jscomp/stdlib-406/stack.resi @@ -18,45 +18,44 @@ This module implements stacks (LIFOs), with in-place modification. ") -@ocaml.doc(" The type of stacks containing elements of type ['a]. ") +/** The type of stacks containing elements of type ['a]. */ type t<'a> -@ocaml.doc(" Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. ") -exception Empty +/** Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. */ exception Empty -@ocaml.doc(" Return a new stack, initially empty. ") +/** Return a new stack, initially empty. */ let create: unit => t<'a> -@ocaml.doc(" [push x s] adds the element [x] at the top of stack [s]. ") +/** [push x s] adds the element [x] at the top of stack [s]. */ let push: ('a, t<'a>) => unit -@ocaml.doc(" [pop s] removes and returns the topmost element in stack [s], - or raises {!Empty} if the stack is empty. ") +/** [pop s] removes and returns the topmost element in stack [s], + or raises {!Empty} if the stack is empty. */ let pop: t<'a> => 'a -@ocaml.doc(" [top s] returns the topmost element in stack [s], - or raises {!Empty} if the stack is empty. ") +/** [top s] returns the topmost element in stack [s], + or raises {!Empty} if the stack is empty. */ let top: t<'a> => 'a -@ocaml.doc(" Discard all elements from a stack. ") +/** Discard all elements from a stack. */ let clear: t<'a> => unit -@ocaml.doc(" Return a copy of the given stack. ") +/** Return a copy of the given stack. */ let copy: t<'a> => t<'a> -@ocaml.doc(" Return [true] if the given stack is empty, [false] otherwise. ") +/** Return [true] if the given stack is empty, [false] otherwise. */ let is_empty: t<'a> => bool -@ocaml.doc(" Return the number of elements in a stack. Time complexity O(1) ") +/** Return the number of elements in a stack. Time complexity O(1) */ let length: t<'a> => int -@ocaml.doc(" [iter f s] applies [f] in turn to all elements of [s], +/** [iter f s] applies [f] in turn to all elements of [s], from the element at the top of the stack to the element at the - bottom of the stack. The stack itself is unchanged. ") + bottom of the stack. The stack itself is unchanged. */ let iter: ('a => unit, t<'a>) => unit -@ocaml.doc(" [fold f accu s] is [(f (... (f (f accu x1) x2) ...) xn)] +/** [fold f accu s] is [(f (... (f (f accu x1) x2) ...) xn)] where [x1] is the top of the stack, [x2] the second element, and [xn] the bottom element. The stack is unchanged. - @since 4.03 ") + @since 4.03 */ let fold: (('b, 'a) => 'b, 'b, t<'a>) => 'b diff --git a/jscomp/stdlib-406/stream.resi b/jscomp/stdlib-406/stream.resi index bd554a84c1..b10c6e5d95 100644 --- a/jscomp/stdlib-406/stream.resi +++ b/jscomp/stdlib-406/stream.resi @@ -17,20 +17,20 @@ " Streams and parsers. " ) -@ocaml.doc(" The type of streams holding values of type ['a]. ") +/** The type of streams holding values of type ['a]. */ type t<'a> -@ocaml.doc(" Raised by parsers when none of the first components of the stream - patterns is accepted. ") +/** Raised by parsers when none of the first components of the stream + patterns is accepted. */ exception Failure -@ocaml.doc(" Raised by parsers when the first component of a stream pattern is - accepted, but one of the following components is rejected. ") +/** Raised by parsers when the first component of a stream pattern is + accepted, but one of the following components is rejected. */ exception Error(string) @@ocaml.text(" {1 Stream builders} ") -@ocaml.doc(" [Stream.from f] returns a stream built from the function [f]. +/** [Stream.from f] returns a stream built from the function [f]. To create a new stream element, the function [f] is called with the current stream count. The user function [f] must return either [Some ] for a value or [None] to specify the end of the @@ -39,52 +39,52 @@ exception Error(string) Do note that the indices passed to [f] may not start at [0] in the general case. For example, [[< '0; '1; Stream.from f >]] would call [f] the first time with count [2]. -") +*/ let from: (int => option<'a>) => t<'a> -@ocaml.doc(" Return the stream holding the elements of the list in the same - order. ") +/** Return the stream holding the elements of the list in the same + order. */ let of_list: list<'a> => t<'a> -@ocaml.doc(" Return the stream of the characters of the string parameter. ") +/** Return the stream of the characters of the string parameter. */ let of_string: string => t -@ocaml.doc(" Return the stream of the characters of the bytes parameter. - @since 4.02.0 ") +/** Return the stream of the characters of the bytes parameter. + @since 4.02.0 */ let of_bytes: bytes => t @@ocaml.text(" {1 Stream iterator} ") -@ocaml.doc(" [Stream.iter f s] scans the whole stream s, applying function [f] - in turn to each stream element encountered. ") +/** [Stream.iter f s] scans the whole stream s, applying function [f] + in turn to each stream element encountered. */ let iter: ('a => unit, t<'a>) => unit @@ocaml.text(" {1 Predefined parsers} ") -@ocaml.doc(" Return the first element of the stream and remove it from the - stream. Raise {!Stream.Failure} if the stream is empty. ") +/** Return the first element of the stream and remove it from the + stream. Raise {!Stream.Failure} if the stream is empty. */ let next: t<'a> => 'a -@ocaml.doc(" Return [()] if the stream is empty, else raise {!Stream.Failure}. ") +/** Return [()] if the stream is empty, else raise {!Stream.Failure}. */ let empty: t<'a> => unit @@ocaml.text(" {1 Useful functions} ") -@ocaml.doc(" Return [Some] of \"the first element\" of the stream, or [None] if - the stream is empty. ") +/** Return [Some] of \"the first element\" of the stream, or [None] if + the stream is empty. */ let peek: t<'a> => option<'a> -@ocaml.doc(" Remove the first element of the stream, possibly unfreezing - it before. ") +/** Remove the first element of the stream, possibly unfreezing + it before. */ let junk: t<'a> => unit -@ocaml.doc(" Return the current count of the stream elements, i.e. the number - of the stream elements discarded. ") +/** Return the current count of the stream elements, i.e. the number + of the stream elements discarded. */ let count: t<'a> => int -@ocaml.doc(" [npeek n] returns the list of the [n] first elements of +/** [npeek n] returns the list of the [n] first elements of the stream, or all its remaining elements if less than [n] - elements are available. ") + elements are available. */ let npeek: (int, t<'a>) => list<'a> @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/string.resi b/jscomp/stdlib-406/string.resi index 7bbfd0f678..7ac1bd04a0 100644 --- a/jscomp/stdlib-406/string.resi +++ b/jscomp/stdlib-406/string.resi @@ -48,81 +48,81 @@ ") -@ocaml.doc(" Return the length (number of characters) of the given string. ") +/** Return the length (number of characters) of the given string. */ external length: string => int = "%string_length" -@ocaml.doc(" [String.get s n] returns the character at index [n] in string [s]. +/** [String.get s n] returns the character at index [n] in string [s]. You can also write [s.[n]] instead of [String.get s n]. - Raise [Invalid_argument] if [n] not a valid index in [s]. ") + Raise [Invalid_argument] if [n] not a valid index in [s]. */ external get: (string, int) => char = "%string_safe_get" -@ocaml.doc(" [String.make n c] returns a fresh string of length [n], +/** [String.make n c] returns a fresh string of length [n], filled with the character [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ let make: (int, char) => string -@ocaml.doc(" [String.init n f] returns a string of length [n], with character +/** [String.init n f] returns a string of length [n], with character [i] initialized to the result of [f i] (called in increasing index order). Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. @since 4.02.0 -") +*/ let init: (int, int => char) => string -@ocaml.doc(" [String.sub s start len] returns a fresh string of length [len], +/** [String.sub s start len] returns a fresh string of length [len], containing the substring of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]. ") + designate a valid substring of [s]. */ let sub: (string, int, int) => string -@ocaml.doc(" Same as {!Bytes.blit_string}. ") +/** Same as {!Bytes.blit_string}. */ let blit: (string, int, bytes, int, int) => unit -@ocaml.doc(" [String.concat sep sl] concatenates the list of strings [sl], +/** [String.concat sep sl] concatenates the list of strings [sl], inserting the separator string [sep] between each. Raise [Invalid_argument] if the result is longer than - {!Sys.max_string_length} bytes. ") + {!Sys.max_string_length} bytes. */ let concat: (string, list) => string -@ocaml.doc(" [String.iter f s] applies function [f] in turn to all +/** [String.iter f s] applies function [f] in turn to all the characters of [s]. It is equivalent to - [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. ") + [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. */ let iter: (char => unit, string) => unit -@ocaml.doc(" Same as {!String.iter}, but the +/** Same as {!String.iter}, but the function is applied to the index of the element as first argument (counting from 0), and the character itself as second argument. - @since 4.00.0 ") + @since 4.00.0 */ let iteri: ((int, char) => unit, string) => unit -@ocaml.doc(" [String.map f s] applies function [f] in turn to all the +/** [String.map f s] applies function [f] in turn to all the characters of [s] (in increasing index order) and stores the results in a new string that is returned. - @since 4.00.0 ") + @since 4.00.0 */ let map: (char => char, string) => string -@ocaml.doc(" [String.mapi f s] calls [f] with each character of [s] and its +/** [String.mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the results in a new string that is returned. - @since 4.02.0 ") + @since 4.02.0 */ let mapi: ((int, char) => char, string) => string -@ocaml.doc(" Return a copy of the argument, without leading and trailing +/** Return a copy of the argument, without leading and trailing whitespace. The characters regarded as whitespace are: [' '], - ['\012'], ['\n'], ['\r'], and ['\t']. If there is neither leading nor + ['\x0c'], ['\n'], ['\r'], and ['\t']. If there is neither leading nor trailing whitespace character in the argument, return the original string itself, not a copy. - @since 4.00.0 ") + @since 4.00.0 */ let trim: string => string -@ocaml.doc(" Return a copy of the argument, with special characters +/** Return a copy of the argument, with special characters represented by escape sequences, following the lexical conventions of OCaml. All characters outside the ASCII printable range (32..126) are @@ -136,42 +136,42 @@ let trim: string => string The function {!Scanf.unescaped} is a left inverse of [escaped], i.e. [Scanf.unescaped (escaped s) = s] for any string [s] (unless - [escape s] fails). ") + [escape s] fails). */ let escaped: string => string -@ocaml.doc(" [String.index s c] returns the index of the first +/** [String.index s c] returns the index of the first occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let index: (string, char) => int -@ocaml.doc(" [String.index_opt s c] returns the index of the first +/** [String.index_opt s c] returns the index of the first occurrence of character [c] in string [s], or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let index_opt: (string, char) => option -@ocaml.doc(" [String.rindex s c] returns the index of the last +/** [String.rindex s c] returns the index of the last occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let rindex: (string, char) => int -@ocaml.doc(" [String.rindex_opt s c] returns the index of the last occurrence +/** [String.rindex_opt s c] returns the index of the last occurrence of character [c] in string [s], or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let rindex_opt: (string, char) => option -@ocaml.doc(" [String.index_from s i c] returns the index of the +/** [String.index_from s i c] returns the index of the first occurrence of character [c] in string [s] after position [i]. [String.index s c] is equivalent to [String.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. ") + Raise [Not_found] if [c] does not occur in [s] after position [i]. */ let index_from: (string, int, char) => int -@ocaml.doc(" [String.index_from_opt s i c] returns the index of the +/** [String.index_from_opt s i c] returns the index of the first occurrence of character [c] in string [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. @@ -179,19 +179,19 @@ let index_from: (string, int, char) => int Raise [Invalid_argument] if [i] is not a valid position in [s]. @since 4.05 -") +*/ let index_from_opt: (string, int, char) => option -@ocaml.doc(" [String.rindex_from s i c] returns the index of the +/** [String.rindex_from s i c] returns the index of the last occurrence of character [c] in string [s] before position [i+1]. [String.rindex s c] is equivalent to [String.rindex_from s (String.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. */ let rindex_from: (string, int, char) => int -@ocaml.doc(" [String.rindex_from_opt s i c] returns the index of the +/** [String.rindex_from_opt s i c] returns the index of the last occurrence of character [c] in string [s] before position [i+1] or [None] if [c] does not occur in [s] before position [i+1]. @@ -201,62 +201,62 @@ let rindex_from: (string, int, char) => int Raise [Invalid_argument] if [i+1] is not a valid position in [s]. @since 4.05 -") +*/ let rindex_from_opt: (string, int, char) => option -@ocaml.doc(" [String.contains s c] tests if character [c] - appears in the string [s]. ") +/** [String.contains s c] tests if character [c] + appears in the string [s]. */ let contains: (string, char) => bool -@ocaml.doc(" [String.contains_from s start c] tests if character [c] +/** [String.contains_from s start c] tests if character [c] appears in [s] after position [start]. [String.contains s c] is equivalent to [String.contains_from s 0 c]. - Raise [Invalid_argument] if [start] is not a valid position in [s]. ") + Raise [Invalid_argument] if [start] is not a valid position in [s]. */ let contains_from: (string, int, char) => bool -@ocaml.doc(" [String.rcontains_from s stop c] tests if character [c] +/** [String.rcontains_from s stop c] tests if character [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. ") + position in [s]. */ let rcontains_from: (string, int, char) => bool -@ocaml.doc(" Return a copy of the argument, with all lowercase letters +/** Return a copy of the argument, with all lowercase letters translated to uppercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let uppercase_ascii: string => string -@ocaml.doc(" Return a copy of the argument, with all uppercase letters +/** Return a copy of the argument, with all uppercase letters translated to lowercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let lowercase_ascii: string => string -@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, +/** Return a copy of the argument, with the first character set to uppercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let capitalize_ascii: string => string -@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, +/** Return a copy of the argument, with the first character set to lowercase, using the US-ASCII character set. - @since 4.03.0 ") + @since 4.03.0 */ let uncapitalize_ascii: string => string -@ocaml.doc(" An alias for the type of strings. ") +/** An alias for the type of strings. */ type t = string -@ocaml.doc(" The comparison function for strings, with the same specification as +/** The comparison function for strings, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [String] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. ") + {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equal function for strings. - @since 4.03.0 ") +/** The equal function for strings. + @since 4.03.0 */ let equal: (t, t) => bool -@ocaml.doc(" [String.split_on_char sep s] returns the list of all (possibly empty) +/** [String.split_on_char sep s] returns the list of all (possibly empty) substrings of [s] that are delimited by the [sep] character. The function's output is specified by the following invariants: @@ -268,7 +268,7 @@ let equal: (t, t) => bool - No string in the result contains the [sep] character. @since 4.04.0 -") +*/ let split_on_char: (char, string) => list @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/stringLabels.resi b/jscomp/stdlib-406/stringLabels.resi index 8552d17b43..a792df1ac5 100644 --- a/jscomp/stdlib-406/stringLabels.resi +++ b/jscomp/stdlib-406/stringLabels.resi @@ -17,120 +17,120 @@ " String operations. " ) -@ocaml.doc(" Return the length (number of characters) of the given string. ") +/** Return the length (number of characters) of the given string. */ external length: string => int = "%string_length" -@ocaml.doc(" [String.get s n] returns the character at index [n] in string [s]. +/** [String.get s n] returns the character at index [n] in string [s]. You can also write [s.[n]] instead of [String.get s n]. - Raise [Invalid_argument] if [n] not a valid index in [s]. ") + Raise [Invalid_argument] if [n] not a valid index in [s]. */ external get: (string, int) => char = "%string_safe_get" -@ocaml.doc(" [String.make n c] returns a fresh string of length [n], +/** [String.make n c] returns a fresh string of length [n], filled with the character [c]. - Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. ") + Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. */ let make: (int, char) => string -@ocaml.doc(" [init n f] returns a string of length [n], +/** [init n f] returns a string of length [n], with character [i] initialized to the result of [f i]. Raise [Invalid_argument] if [n < 0] or [n > ]{!Sys.max_string_length}. - @since 4.02.0 ") + @since 4.02.0 */ let init: (int, ~f: int => char) => string -@ocaml.doc(" [String.sub s start len] returns a fresh string of length [len], +/** [String.sub s start len] returns a fresh string of length [len], containing the substring of [s] that starts at position [start] and has length [len]. Raise [Invalid_argument] if [start] and [len] do not - designate a valid substring of [s]. ") + designate a valid substring of [s]. */ let sub: (string, ~pos: int, ~len: int) => string -@ocaml.doc(" [String.blit src srcoff dst dstoff len] copies [len] bytes +/** [String.blit src srcoff dst dstoff len] copies [len] bytes from the string [src], starting at index [srcoff], to byte sequence [dst], starting at character number [dstoff]. Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid range of [src], or if [dstoff] and [len] - do not designate a valid range of [dst]. ") + do not designate a valid range of [dst]. */ let blit: (~src: string, ~src_pos: int, ~dst: bytes, ~dst_pos: int, ~len: int) => unit -@ocaml.doc(" [String.concat sep sl] concatenates the list of strings [sl], - inserting the separator string [sep] between each. ") +/** [String.concat sep sl] concatenates the list of strings [sl], + inserting the separator string [sep] between each. */ let concat: (~sep: string, list) => string -@ocaml.doc(" [String.iter f s] applies function [f] in turn to all +/** [String.iter f s] applies function [f] in turn to all the characters of [s]. It is equivalent to - [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. ") + [f s.[0]; f s.[1]; ...; f s.[String.length s - 1]; ()]. */ let iter: (~f: char => unit, string) => unit -@ocaml.doc(" Same as {!String.iter}, but the +/** Same as {!String.iter}, but the function is applied to the index of the element as first argument (counting from 0), and the character itself as second argument. - @since 4.00.0 ") + @since 4.00.0 */ let iteri: (~f: (int, char) => unit, string) => unit -@ocaml.doc(" [String.map f s] applies function [f] in turn to all +/** [String.map f s] applies function [f] in turn to all the characters of [s] and stores the results in a new string that is returned. - @since 4.00.0 ") + @since 4.00.0 */ let map: (~f: char => char, string) => string -@ocaml.doc(" [String.mapi f s] calls [f] with each character of [s] and its +/** [String.mapi f s] calls [f] with each character of [s] and its index (in increasing index order) and stores the results in a new string that is returned. - @since 4.02.0 ") + @since 4.02.0 */ let mapi: (~f: (int, char) => char, string) => string -@ocaml.doc(" Return a copy of the argument, without leading and trailing +/** Return a copy of the argument, without leading and trailing whitespace. The characters regarded as whitespace are: [' '], - ['\012'], ['\n'], ['\r'], and ['\t']. If there is no leading nor + ['\x0c'], ['\n'], ['\r'], and ['\t']. If there is no leading nor trailing whitespace character in the argument, return the original string itself, not a copy. - @since 4.00.0 ") + @since 4.00.0 */ let trim: string => string -@ocaml.doc(" Return a copy of the argument, with special characters +/** Return a copy of the argument, with special characters represented by escape sequences, following the lexical conventions of OCaml. If there is no special character in the argument, return the original string itself, - not a copy. Its inverse function is Scanf.unescaped. ") + not a copy. Its inverse function is Scanf.unescaped. */ let escaped: string => string -@ocaml.doc(" [String.index s c] returns the index of the first +/** [String.index s c] returns the index of the first occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let index: (string, char) => int -@ocaml.doc(" [String.index_opt s c] returns the index of the first +/** [String.index_opt s c] returns the index of the first occurrence of character [c] in string [s], or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let index_opt: (string, char) => option -@ocaml.doc(" [String.rindex s c] returns the index of the last +/** [String.rindex s c] returns the index of the last occurrence of character [c] in string [s]. - Raise [Not_found] if [c] does not occur in [s]. ") + Raise [Not_found] if [c] does not occur in [s]. */ let rindex: (string, char) => int -@ocaml.doc(" [String.rindex_opt s c] returns the index of the last occurrence +/** [String.rindex_opt s c] returns the index of the last occurrence of character [c] in string [s], or [None] if [c] does not occur in [s]. - @since 4.05 ") + @since 4.05 */ let rindex_opt: (string, char) => option -@ocaml.doc(" [String.index_from s i c] returns the index of the +/** [String.index_from s i c] returns the index of the first occurrence of character [c] in string [s] after position [i]. [String.index s c] is equivalent to [String.index_from s 0 c]. Raise [Invalid_argument] if [i] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] after position [i]. ") + Raise [Not_found] if [c] does not occur in [s] after position [i]. */ let index_from: (string, int, char) => int -@ocaml.doc(" [String.index_from_opt s i c] returns the index of the +/** [String.index_from_opt s i c] returns the index of the first occurrence of character [c] in string [s] after position [i] or [None] if [c] does not occur in [s] after position [i]. @@ -138,19 +138,19 @@ let index_from: (string, int, char) => int Raise [Invalid_argument] if [i] is not a valid position in [s]. @since 4.05 -") +*/ let index_from_opt: (string, int, char) => option -@ocaml.doc(" [String.rindex_from s i c] returns the index of the +/** [String.rindex_from s i c] returns the index of the last occurrence of character [c] in string [s] before position [i+1]. [String.rindex s c] is equivalent to [String.rindex_from s (String.length s - 1) c]. Raise [Invalid_argument] if [i+1] is not a valid position in [s]. - Raise [Not_found] if [c] does not occur in [s] before position [i+1]. ") + Raise [Not_found] if [c] does not occur in [s] before position [i+1]. */ let rindex_from: (string, int, char) => int -@ocaml.doc(" [String.rindex_from_opt s i c] returns the index of the +/** [String.rindex_from_opt s i c] returns the index of the last occurrence of character [c] in string [s] before position [i+1] or [None] if [c] does not occur in [s] before position [i+1]. @@ -160,62 +160,62 @@ let rindex_from: (string, int, char) => int Raise [Invalid_argument] if [i+1] is not a valid position in [s]. @since 4.05 -") +*/ let rindex_from_opt: (string, int, char) => option -@ocaml.doc(" [String.contains s c] tests if character [c] - appears in the string [s]. ") +/** [String.contains s c] tests if character [c] + appears in the string [s]. */ let contains: (string, char) => bool -@ocaml.doc(" [String.contains_from s start c] tests if character [c] +/** [String.contains_from s start c] tests if character [c] appears in [s] after position [start]. [String.contains s c] is equivalent to [String.contains_from s 0 c]. - Raise [Invalid_argument] if [start] is not a valid position in [s]. ") + Raise [Invalid_argument] if [start] is not a valid position in [s]. */ let contains_from: (string, int, char) => bool -@ocaml.doc(" [String.rcontains_from s stop c] tests if character [c] +/** [String.rcontains_from s stop c] tests if character [c] appears in [s] before position [stop+1]. Raise [Invalid_argument] if [stop < 0] or [stop+1] is not a valid - position in [s]. ") + position in [s]. */ let rcontains_from: (string, int, char) => bool -@ocaml.doc(" Return a copy of the argument, with all lowercase letters +/** Return a copy of the argument, with all lowercase letters translated to uppercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let uppercase_ascii: string => string -@ocaml.doc(" Return a copy of the argument, with all uppercase letters +/** Return a copy of the argument, with all uppercase letters translated to lowercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let lowercase_ascii: string => string -@ocaml.doc(" Return a copy of the argument, with the first character set to uppercase, +/** Return a copy of the argument, with the first character set to uppercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let capitalize_ascii: string => string -@ocaml.doc(" Return a copy of the argument, with the first character set to lowercase, +/** Return a copy of the argument, with the first character set to lowercase, using the US-ASCII character set. - @since 4.05.0 ") + @since 4.05.0 */ let uncapitalize_ascii: string => string -@ocaml.doc(" An alias for the type of strings. ") +/** An alias for the type of strings. */ type t = string -@ocaml.doc(" The comparison function for strings, with the same specification as +/** The comparison function for strings, with the same specification as {!Pervasives.compare}. Along with the type [t], this function [compare] allows the module [String] to be passed as argument to the functors - {!Set.Make} and {!Map.Make}. ") + {!Set.Make} and {!Map.Make}. */ let compare: (t, t) => int -@ocaml.doc(" The equal function for strings. - @since 4.05.0 ") +/** The equal function for strings. + @since 4.05.0 */ let equal: (t, t) => bool -@ocaml.doc(" [String.split_on_char sep s] returns the list of all (possibly empty) +/** [String.split_on_char sep s] returns the list of all (possibly empty) substrings of [s] that are delimited by the [sep] character. The function's output is specified by the following invariants: @@ -227,7 +227,7 @@ let equal: (t, t) => bool - No string in the result contains the [sep] character. @since 4.05.0 -") +*/ let split_on_char: (~sep: char, string) => list @@ocaml.text("/*") diff --git a/jscomp/stdlib-406/sys.resi b/jscomp/stdlib-406/sys.resi index 10aac3616b..419da77aa0 100644 --- a/jscomp/stdlib-406/sys.resi +++ b/jscomp/stdlib-406/sys.resi @@ -20,293 +20,292 @@ an error. ") -@ocaml.doc(" The command line arguments given to the process. +/** The command line arguments given to the process. The first element is the command name used to invoke the program. The following elements are the command-line arguments - given to the program. ") + given to the program. */ let argv: array -@ocaml.doc(" The name of the file containing the executable currently running. ") +/** The name of the file containing the executable currently running. */ let executable_name: string -@ocaml.doc(" Test if a file with the given name exists. ") +/** Test if a file with the given name exists. */ external file_exists: string => bool = "?sys_file_exists" -@ocaml.doc(" Returns [true] if the given name refers to a directory, +/** Returns [true] if the given name refers to a directory, [false] if it refers to another kind of file. Raise [Sys_error] if no file exists with the given name. @since 3.10.0 -") +*/ external is_directory: string => bool = "?sys_is_directory" -@ocaml.doc(" Remove the given file name from the file system. ") +/** Remove the given file name from the file system. */ external remove: string => unit = "?sys_remove" -@ocaml.doc(" Rename a file. [rename oldpath newpath] renames the file +/** Rename a file. [rename oldpath newpath] renames the file called [oldpath], giving it [newpath] as its new name, moving it between directories if needed. If [newpath] already exists, its contents will be replaced with those of [oldpath]. Depending on the operating system, the metadata (permissions, owner, etc) of [newpath] can either be preserved or be replaced by those of [oldpath]. - @since 4.06 concerning the \"replace existing file\" behavior ") + @since 4.06 concerning the \"replace existing file\" behavior */ external rename: (string, string) => unit = "?sys_rename" -@ocaml.doc(" Return the value associated to a variable in the process - environment. Raise [Not_found] if the variable is unbound. ") +/** Return the value associated to a variable in the process + environment. Raise [Not_found] if the variable is unbound. */ external getenv: string => string = "?sys_getenv" -@ocaml.doc(" Return the value associated to a variable in the process +/** Return the value associated to a variable in the process environment or [None] if the variable is unbound. @since 4.05 -") +*/ let getenv_opt: string => option -@ocaml.doc(" Execute the given shell command and return its exit code. ") +/** Execute the given shell command and return its exit code. */ let command: string => int -@ocaml.doc(" Return the processor time, in seconds, used by the program - since the beginning of execution. ") +/** Return the processor time, in seconds, used by the program + since the beginning of execution. */ external time: unit => float = "?sys_time" -@ocaml.doc(" Change the current working directory of the process. ") +/** Change the current working directory of the process. */ external chdir: string => unit = "?sys_chdir" -@ocaml.doc(" Return the current working directory of the process. ") +/** Return the current working directory of the process. */ external getcwd: unit => string = "?sys_getcwd" -@ocaml.doc(" Return the names of all files present in the given directory. +/** Return the names of all files present in the given directory. Names denoting the current directory and the parent directory ([\".\"] and [\"..\"] in Unix) are not returned. Each string in the result is a file name rather than a complete path. There is no guarantee that the name strings in the resulting array will appear in any specific order; they are not, in particular, guaranteed to - appear in alphabetical order. ") + appear in alphabetical order. */ external readdir: string => array = "?sys_read_directory" -@ocaml.doc(" This reference is initially set to [false] in standalone +/** This reference is initially set to [false] in standalone programs and to [true] if the code is being executed under - the interactive toplevel system [ocaml]. ") + the interactive toplevel system [ocaml]. */ let interactive: ref -@ocaml.doc(" Operating system currently executing the OCaml program. One of +/** Operating system currently executing the OCaml program. One of - [\"Unix\"] (for all Unix versions, including Linux and Mac OS X), - [\"Win32\"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw), -- [\"Cygwin\"] (for MS-Windows, OCaml compiled with Cygwin). ") +- [\"Cygwin\"] (for MS-Windows, OCaml compiled with Cygwin). */ let os_type: string -@ocaml.doc(" Currently, the official distribution only supports [Native] and +/** Currently, the official distribution only supports [Native] and [Bytecode], but it can be other backends with alternative compilers, for example, javascript. @since 4.04.0 -") +*/ type backend_type = | Native | Bytecode | Other(string) -@ocaml.doc(" Backend type currently executing the OCaml program. +/** Backend type currently executing the OCaml program. @since 4.04.0 - ") + */ let backend_type: backend_type -@ocaml.doc(" True if [Sys.os_type = \"Unix\"]. - @since 4.01.0 ") +/** True if [Sys.os_type = \"Unix\"]. + @since 4.01.0 */ let unix: bool -@ocaml.doc(" True if [Sys.os_type = \"Win32\"]. - @since 4.01.0 ") +/** True if [Sys.os_type = \"Win32\"]. + @since 4.01.0 */ let win32: bool -@ocaml.doc(" True if [Sys.os_type = \"Cygwin\"]. - @since 4.01.0 ") +/** True if [Sys.os_type = \"Cygwin\"]. + @since 4.01.0 */ let cygwin: bool -@ocaml.doc(" Size of one word on the machine currently executing the OCaml - program, in bits: 32 or 64. ") +/** Size of one word on the machine currently executing the OCaml + program, in bits: 32 or 64. */ let word_size: int -@ocaml.doc(" Size of an int. It is 31 bits (resp. 63 bits) when using the +/** Size of an int. It is 31 bits (resp. 63 bits) when using the OCaml compiler on a 32 bits (resp. 64 bits) platform. It may differ for other compilers, e.g. it is 32 bits when compiling to JavaScript. - @since 4.03.0 ") + @since 4.03.0 */ let int_size: int -@ocaml.doc(" Whether the machine currently executing the Caml program is big-endian. - @since 4.00.0 ") +/** Whether the machine currently executing the Caml program is big-endian. + @since 4.00.0 */ let big_endian: bool -@ocaml.doc(" Maximum length of strings and byte sequences. ") +/** Maximum length of strings and byte sequences. */ let max_string_length: int -@ocaml.doc(" Maximum length of a normal array. The maximum length of a float +/** Maximum length of a normal array. The maximum length of a float array is [max_array_length/2] on 32-bit machines and - [max_array_length] on 64-bit machines. ") + [max_array_length] on 64-bit machines. */ let max_array_length: int -@ocaml.doc(" Return the name of the runtime variant the program is running on. +/** Return the name of the runtime variant the program is running on. This is normally the argument given to [-runtime-variant] at compile time, but for byte-code it can be changed after compilation. - @since 4.03.0 ") + @since 4.03.0 */ external runtime_variant: unit => string = "?runtime_variant" -@ocaml.doc(" Return the value of the runtime parameters, in the same format +/** Return the value of the runtime parameters, in the same format as the contents of the [OCAMLRUNPARAM] environment variable. - @since 4.03.0 ") + @since 4.03.0 */ external runtime_parameters: unit => string = "?runtime_parameters" @@ocaml.text(" {1 Signal handling} ") -@ocaml.doc(" What to do when receiving a signal: +/** What to do when receiving a signal: - [Signal_default]: take the default behavior (usually: abort the program) - [Signal_ignore]: ignore the signal - [Signal_handle f]: call function [f], giving it the signal - number as argument. ") + number as argument. */ type signal_behavior = | Signal_default | Signal_ignore - | @ocaml.doc(" ") Signal_handle(int => unit) + | /** */ Signal_handle(int => unit) -@ocaml.doc(" Set the behavior of the system on receipt of a given signal. The +/** Set the behavior of the system on receipt of a given signal. The first argument is the signal number. Return the behavior previously associated with the signal. If the signal number is invalid (or not available on your system), an [Invalid_argument] - exception is raised. ") + exception is raised. */ let signal: (int, signal_behavior) => signal_behavior -@ocaml.doc(" Same as {!Sys.signal} but return value is ignored. ") +/** Same as {!Sys.signal} but return value is ignored. */ let set_signal: (int, signal_behavior) => unit @@ocaml.text(" {2 Signal numbers for the standard POSIX signals.} ") -@ocaml.doc(" Abnormal termination ") +/** Abnormal termination */ let sigabrt: int -@ocaml.doc(" Timeout ") +/** Timeout */ let sigalrm: int -@ocaml.doc(" Arithmetic exception ") +/** Arithmetic exception */ let sigfpe: int -@ocaml.doc(" Hangup on controlling terminal ") +/** Hangup on controlling terminal */ let sighup: int -@ocaml.doc(" Invalid hardware instruction ") +/** Invalid hardware instruction */ let sigill: int -@ocaml.doc(" Interactive interrupt (ctrl-C) ") +/** Interactive interrupt (ctrl-C) */ let sigint: int -@ocaml.doc(" Termination (cannot be ignored) ") +/** Termination (cannot be ignored) */ let sigkill: int -@ocaml.doc(" Broken pipe ") +/** Broken pipe */ let sigpipe: int -@ocaml.doc(" Interactive termination ") +/** Interactive termination */ let sigquit: int -@ocaml.doc(" Invalid memory reference ") +/** Invalid memory reference */ let sigsegv: int -@ocaml.doc(" Termination ") +/** Termination */ let sigterm: int -@ocaml.doc(" Application-defined signal 1 ") +/** Application-defined signal 1 */ let sigusr1: int -@ocaml.doc(" Application-defined signal 2 ") +/** Application-defined signal 2 */ let sigusr2: int -@ocaml.doc(" Child process terminated ") +/** Child process terminated */ let sigchld: int -@ocaml.doc(" Continue ") +/** Continue */ let sigcont: int -@ocaml.doc(" Stop ") +/** Stop */ let sigstop: int -@ocaml.doc(" Interactive stop ") +/** Interactive stop */ let sigtstp: int -@ocaml.doc(" Terminal read from background process ") +/** Terminal read from background process */ let sigttin: int -@ocaml.doc(" Terminal write from background process ") +/** Terminal write from background process */ let sigttou: int -@ocaml.doc(" Timeout in virtual time ") +/** Timeout in virtual time */ let sigvtalrm: int -@ocaml.doc(" Profiling interrupt ") +/** Profiling interrupt */ let sigprof: int -@ocaml.doc(" Bus error - @since 4.03 ") +/** Bus error + @since 4.03 */ let sigbus: int -@ocaml.doc(" Pollable event - @since 4.03 ") +/** Pollable event + @since 4.03 */ let sigpoll: int -@ocaml.doc(" Bad argument to routine - @since 4.03 ") +/** Bad argument to routine + @since 4.03 */ let sigsys: int -@ocaml.doc(" Trace/breakpoint trap - @since 4.03 ") +/** Trace/breakpoint trap + @since 4.03 */ let sigtrap: int -@ocaml.doc(" Urgent condition on socket - @since 4.03 ") +/** Urgent condition on socket + @since 4.03 */ let sigurg: int -@ocaml.doc(" Timeout in cpu time - @since 4.03 ") +/** Timeout in cpu time + @since 4.03 */ let sigxcpu: int -@ocaml.doc(" File size limit exceeded - @since 4.03 ") +/** File size limit exceeded + @since 4.03 */ let sigxfsz: int -@ocaml.doc(" Exception raised on interactive interrupt if {!Sys.catch_break} - is on. ") -exception Break +/** Exception raised on interactive interrupt if {!Sys.catch_break} + is on. */ exception Break -@ocaml.doc(" [catch_break] governs whether interactive interrupt (ctrl-C) +/** [catch_break] governs whether interactive interrupt (ctrl-C) terminates the program or raises the [Break] exception. Call [catch_break true] to enable raising [Break], and [catch_break false] to let the system - terminate the program on user interrupt. ") + terminate the program on user interrupt. */ let catch_break: bool => unit -@ocaml.doc(" [ocaml_version] is the version of OCaml. +/** [ocaml_version] is the version of OCaml. It is a string of the form [\"major.minor[.patchlevel][+additional-info]\"], where [major], [minor], and [patchlevel] are integers, and [additional-info] is an arbitrary string. The [[.patchlevel]] and - [[+additional-info]] parts may be absent. ") + [[+additional-info]] parts may be absent. */ let ocaml_version: string -@ocaml.doc(" Control whether the OCaml runtime system can emit warnings +/** Control whether the OCaml runtime system can emit warnings on stderr. Currently, the only supported warning is triggered when a channel created by [open_*] functions is finalized without being closed. Runtime warnings are enabled by default. - @since 4.03.0 ") + @since 4.03.0 */ let enable_runtime_warnings: bool => unit -@ocaml.doc(" Return whether runtime warnings are currently enabled. +/** Return whether runtime warnings are currently enabled. - @since 4.03.0 ") + @since 4.03.0 */ let runtime_warnings_enabled: unit => bool @@ocaml.text(" {1 Optimization} ") -@ocaml.doc(" For the purposes of optimization, [opaque_identity] behaves like an +/** For the purposes of optimization, [opaque_identity] behaves like an unknown (and thus possibly side-effecting) function. At runtime, [opaque_identity] disappears altogether. @@ -320,5 +319,5 @@ let runtime_warnings_enabled: unit => bool ]} @since 4.03.0 -") +*/ external opaque_identity: 'a => 'a = "%opaque" diff --git a/jscomp/stdlib-406/uchar.resi b/jscomp/stdlib-406/uchar.resi index 79e22862cb..7c240215f8 100644 --- a/jscomp/stdlib-406/uchar.resi +++ b/jscomp/stdlib-406/uchar.resi @@ -17,82 +17,82 @@ @since 4.03 ") -@ocaml.doc(" The type for Unicode characters. +/** The type for Unicode characters. A value of this type represents an Unicode {{:http://unicode.org/glossary/#unicode_scalar_value}scalar value} which is an integer in the ranges [0x0000]...[0xD7FF] or - [0xE000]...[0x10FFFF]. ") + [0xE000]...[0x10FFFF]. */ type t -@ocaml.doc(" [min] is U+0000. ") +/** [min] is U+0000. */ let min: t -@ocaml.doc(" [max] is U+10FFFF. ") +/** [max] is U+10FFFF. */ let max: t -@ocaml.doc(" [bom] is U+FEFF, the +/** [bom] is U+FEFF, the {{:http://unicode.org/glossary/#byte_order_mark}byte order mark} (BOM) character. - @since 4.06.0 ") + @since 4.06.0 */ let bom: t -@ocaml.doc(" [rep] is U+FFFD, the +/** [rep] is U+FFFD, the {{:http://unicode.org/glossary/#replacement_character}replacement} character. - @since 4.06.0 ") + @since 4.06.0 */ let rep: t -@ocaml.doc(" [succ u] is the scalar value after [u] in the set of Unicode scalar +/** [succ u] is the scalar value after [u] in the set of Unicode scalar values. - @raise Invalid_argument if [u] is {!max}. ") + @raise Invalid_argument if [u] is {!max}. */ let succ: t => t -@ocaml.doc(" [pred u] is the scalar value before [u] in the set of Unicode scalar +/** [pred u] is the scalar value before [u] in the set of Unicode scalar values. - @raise Invalid_argument if [u] is {!min}. ") + @raise Invalid_argument if [u] is {!min}. */ let pred: t => t -@ocaml.doc(" [is_valid n] is [true] iff [n] is an Unicode scalar value - (i.e. in the ranges [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]).") +/** [is_valid n] is [true] iff [n] is an Unicode scalar value + (i.e. in the ranges [0x0000]...[0xD7FF] or [0xE000]...[0x10FFFF]).*/ let is_valid: int => bool -@ocaml.doc(" [of_int i] is [i] as an Unicode character. +/** [of_int i] is [i] as an Unicode character. - @raise Invalid_argument if [i] does not satisfy {!is_valid}. ") + @raise Invalid_argument if [i] does not satisfy {!is_valid}. */ let of_int: int => t @@ocaml.text("/*") let unsafe_of_int: int => t @@ocaml.text("/*") -@ocaml.doc(" [to_int u] is [u] as an integer. ") +/** [to_int u] is [u] as an integer. */ let to_int: t => int -@ocaml.doc(" [is_char u] is [true] iff [u] is a latin1 OCaml character. ") +/** [is_char u] is [true] iff [u] is a latin1 OCaml character. */ let is_char: t => bool -@ocaml.doc(" [of_char c] is [c] as an Unicode character. ") +/** [of_char c] is [c] as an Unicode character. */ let of_char: char => t -@ocaml.doc(" [to_char u] is [u] as an OCaml latin1 character. +/** [to_char u] is [u] as an OCaml latin1 character. - @raise Invalid_argument if [u] does not satisfy {!is_char}. ") + @raise Invalid_argument if [u] does not satisfy {!is_char}. */ let to_char: t => char @@ocaml.text("/*") let unsafe_to_char: t => char @@ocaml.text("/*") -@ocaml.doc(" [equal u u'] is [u = u']. ") +/** [equal u u'] is [u = u']. */ let equal: (t, t) => bool -@ocaml.doc(" [compare u u'] is [Pervasives.compare u u']. ") +/** [compare u u'] is [Pervasives.compare u u']. */ let compare: (t, t) => int -@ocaml.doc(" [hash u] associates a non-negative integer to [u]. ") +/** [hash u] associates a non-negative integer to [u]. */ let hash: t => int From 6e4dde114ba3ef6f8d79c3876308b35d05a1a409 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Mon, 7 Aug 2023 12:17:06 +0200 Subject: [PATCH 4/9] format --- jscomp/stdlib-406/string.res | 16 ++++++++-------- jscomp/stdlib-406/stringLabels.res | 16 ++++++++-------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/jscomp/stdlib-406/string.res b/jscomp/stdlib-406/string.res index ba88a522e6..91ad85a2b3 100644 --- a/jscomp/stdlib-406/string.res +++ b/jscomp/stdlib-406/string.res @@ -32,8 +32,8 @@ let bos = B.unsafe_of_string external make: (int, char) => string = "?string_repeat" -let init = (n, f) => B.init(n, f) |> bts -let sub = (s, ofs, len) => B.sub(bos(s), ofs, len) |> bts +let init = (n, f) => bts(B.init(n, f)) +let sub = (s, ofs, len) => bts(B.sub(bos(s), ofs, len)) let blit = B.blit_string %%private(@send external join: (array, string) => string = "join") @@ -52,8 +52,8 @@ let iteri = (f, s) => f(i, unsafe_get(s, i)) } -let map = (f, s) => B.map(f, bos(s)) |> bts -let mapi = (f, s) => B.mapi(f, bos(s)) |> bts +let map = (f, s) => bts(B.map(f, bos(s))) +let mapi = (f, s) => bts(B.mapi(f, bos(s))) /* Beware: we cannot use B.trim or B.escape because they always make a copy, but String.mli spells out some cases where we are not allowed @@ -212,10 +212,10 @@ let rcontains_from = (s, i, c) => } } -let uppercase_ascii = s => B.uppercase_ascii(bos(s)) |> bts -let lowercase_ascii = s => B.lowercase_ascii(bos(s)) |> bts -let capitalize_ascii = s => B.capitalize_ascii(bos(s)) |> bts -let uncapitalize_ascii = s => B.uncapitalize_ascii(bos(s)) |> bts +let uppercase_ascii = s => bts(B.uppercase_ascii(bos(s))) +let lowercase_ascii = s => bts(B.lowercase_ascii(bos(s))) +let capitalize_ascii = s => bts(B.capitalize_ascii(bos(s))) +let uncapitalize_ascii = s => bts(B.uncapitalize_ascii(bos(s))) type t = string diff --git a/jscomp/stdlib-406/stringLabels.res b/jscomp/stdlib-406/stringLabels.res index 6d6511f21f..869286af09 100644 --- a/jscomp/stdlib-406/stringLabels.res +++ b/jscomp/stdlib-406/stringLabels.res @@ -32,8 +32,8 @@ let bos = B.unsafe_of_string external make: (int, char) => string = "?string_repeat" -let init = (n, ~f) => B.init(n, f) |> bts -let sub = (s, ~pos as ofs, ~len) => B.sub(bos(s), ofs, len) |> bts +let init = (n, ~f) => bts(B.init(n, f)) +let sub = (s, ~pos as ofs, ~len) => bts(B.sub(bos(s), ofs, len)) let blit = (~src, ~src_pos, ~dst, ~dst_pos, ~len) => B.blit_string(src, src_pos, dst, dst_pos, len) %%private(@send external join: (array, string) => string = "join") @@ -52,8 +52,8 @@ let iteri = (~f, s) => f(i, unsafe_get(s, i)) } -let map = (~f, s) => B.map(f, bos(s)) |> bts -let mapi = (~f, s) => B.mapi(f, bos(s)) |> bts +let map = (~f, s) => bts(B.map(f, bos(s))) +let mapi = (~f, s) => bts(B.mapi(f, bos(s))) /* Beware: we cannot use B.trim or B.escape because they always make a copy, but String.mli spells out some cases where we are not allowed @@ -212,10 +212,10 @@ let rcontains_from = (s, i, c) => } } -let uppercase_ascii = s => B.uppercase_ascii(bos(s)) |> bts -let lowercase_ascii = s => B.lowercase_ascii(bos(s)) |> bts -let capitalize_ascii = s => B.capitalize_ascii(bos(s)) |> bts -let uncapitalize_ascii = s => B.uncapitalize_ascii(bos(s)) |> bts +let uppercase_ascii = s => bts(B.uppercase_ascii(bos(s))) +let lowercase_ascii = s => bts(B.lowercase_ascii(bos(s))) +let capitalize_ascii = s => bts(B.capitalize_ascii(bos(s))) +let uncapitalize_ascii = s => bts(B.uncapitalize_ascii(bos(s))) type t = string From 17c6b81c5075381d1df168fad130d7106046ba57 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Mon, 7 Aug 2023 12:17:52 +0200 Subject: [PATCH 5/9] @ocaml.deprecated -> @deprecated --- jscomp/stdlib-406/array.resi | 6 +++--- jscomp/stdlib-406/arrayLabels.resi | 6 +++--- jscomp/stdlib-406/char.resi | 4 ++-- jscomp/stdlib-406/filename.resi | 2 +- jscomp/stdlib-406/lazy.resi | 6 +++--- jscomp/stdlib-406/pervasives.resi | 4 ++-- jscomp/stdlib-406/pervasivesU.resi | 4 ++-- jscomp/stdlib-406/sort.resi | 6 +++--- 8 files changed, 19 insertions(+), 19 deletions(-) diff --git a/jscomp/stdlib-406/array.resi b/jscomp/stdlib-406/array.resi index 1fff3bbdb3..57aa3efdd8 100644 --- a/jscomp/stdlib-406/array.resi +++ b/jscomp/stdlib-406/array.resi @@ -50,7 +50,7 @@ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" size is only [Sys.max_array_length / 2].*/ external make: (int, 'a) => array<'a> = "?make_vect" -@ocaml.deprecated("Use Array.make instead.") +@deprecated("Use Array.make instead.") /** @deprecated [Array.create] is an alias for {!Array.make}. */ external create: (int, 'a) => array<'a> = "?make_vect" @@ -59,7 +59,7 @@ external create: (int, 'a) => array<'a> = "?make_vect" @since 4.03 */ external create_float: int => array = "?make_float_vect" -@ocaml.deprecated("Use Array.create_float instead.") +@deprecated("Use Array.create_float instead.") /** @deprecated [Array.make_float] is an alias for {!Array.create_float}. */ let make_float: int => array @@ -86,7 +86,7 @@ let init: (int, int => 'a) => array<'a> size is only [Sys.max_array_length / 2]. */ let make_matrix: (int, int, 'a) => array> -@ocaml.deprecated("Use Array.make_matrix instead.") +@deprecated("Use Array.make_matrix instead.") /** @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. */ let create_matrix: (int, int, 'a) => array> diff --git a/jscomp/stdlib-406/arrayLabels.resi b/jscomp/stdlib-406/arrayLabels.resi index 9f6b5a4ae3..ca0e9d093c 100644 --- a/jscomp/stdlib-406/arrayLabels.resi +++ b/jscomp/stdlib-406/arrayLabels.resi @@ -50,7 +50,7 @@ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" size is only [Sys.max_array_length / 2].*/ external make: (int, 'a) => array<'a> = "?make_vect" -@ocaml.deprecated("Use Array.make instead.") +@deprecated("Use Array.make instead.") /** @deprecated [Array.create] is an alias for {!Array.make}. */ external create: (int, 'a) => array<'a> = "?make_vect" @@ -77,7 +77,7 @@ let init: (int, ~f: int => 'a) => array<'a> size is only [Sys.max_array_length / 2]. */ let make_matrix: (~dimx: int, ~dimy: int, 'a) => array> -@ocaml.deprecated("Use Array.make_matrix instead.") +@deprecated("Use Array.make_matrix instead.") /** @deprecated [Array.create_matrix] is an alias for {!Array.make_matrix}. */ let create_matrix: (~dimx: int, ~dimy: int, 'a) => array> @@ -201,7 +201,7 @@ let memq: ('a, ~set: array<'a>) => bool @since 4.03 */ external create_float: int => array = "?make_float_vect" -@ocaml.deprecated("Use Array.create_float instead.") +@deprecated("Use Array.create_float instead.") /** @deprecated [Array.make_float] is an alias for {!Array.create_float}. */ let make_float: int => array diff --git a/jscomp/stdlib-406/char.resi b/jscomp/stdlib-406/char.resi index 713fb721a6..e42e0f0d2d 100644 --- a/jscomp/stdlib-406/char.resi +++ b/jscomp/stdlib-406/char.resi @@ -32,13 +32,13 @@ let chr: int => char escaped, as well as backslash, double-quote, and single-quote. */ let escaped: char => string -@ocaml.deprecated("Use Char.lowercase_ascii instead.") +@deprecated("Use Char.lowercase_ascii instead.") /** Convert the given character to its equivalent lowercase character, using the ISO Latin-1 (8859-1) character set. @deprecated Functions operating on Latin-1 character set are deprecated. */ let lowercase: char => char -@ocaml.deprecated("Use Char.uppercase_ascii instead.") +@deprecated("Use Char.uppercase_ascii instead.") /** Convert the given character to its equivalent uppercase character, using the ISO Latin-1 (8859-1) character set. @deprecated Functions operating on Latin-1 character set are deprecated. */ diff --git a/jscomp/stdlib-406/filename.resi b/jscomp/stdlib-406/filename.resi index 3a77eea03d..0c3af74187 100644 --- a/jscomp/stdlib-406/filename.resi +++ b/jscomp/stdlib-406/filename.resi @@ -114,7 +114,7 @@ let get_temp_dir_name: unit => string */ let set_temp_dir_name: string => unit -@ocaml.deprecated("Use Filename.get_temp_dir_name instead") +@deprecated("Use Filename.get_temp_dir_name instead") /** The name of the initial temporary directory: Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" if the variable is not set. diff --git a/jscomp/stdlib-406/lazy.resi b/jscomp/stdlib-406/lazy.resi index cf8d3c2ecd..594b8e4b88 100644 --- a/jscomp/stdlib-406/lazy.resi +++ b/jscomp/stdlib-406/lazy.resi @@ -83,11 +83,11 @@ let from_val: 'a => t<'a> @since 4.00.0 */ let is_val: t<'a> => bool -@ocaml.deprecated("Use Lazy.from_fun instead.") /** @deprecated synonym for [from_fun]. */ +@deprecated("Use Lazy.from_fun instead.") /** @deprecated synonym for [from_fun]. */ let lazy_from_fun: (unit => 'a) => t<'a> -@ocaml.deprecated("Use Lazy.from_val instead.") /** @deprecated synonym for [from_val]. */ +@deprecated("Use Lazy.from_val instead.") /** @deprecated synonym for [from_val]. */ let lazy_from_val: 'a => t<'a> -@ocaml.deprecated("Use Lazy.is_val instead.") /** @deprecated synonym for [is_val]. */ +@deprecated("Use Lazy.is_val instead.") /** @deprecated synonym for [is_val]. */ let lazy_is_val: t<'a> => bool diff --git a/jscomp/stdlib-406/pervasives.resi b/jscomp/stdlib-406/pervasives.resi index 705a7623a5..7b27b406f8 100644 --- a/jscomp/stdlib-406/pervasives.resi +++ b/jscomp/stdlib-406/pervasives.resi @@ -632,7 +632,7 @@ external int_of_string: string => int = "?int_of_string" */ let int_of_string_opt: string => option -@ocaml.deprecated( +@deprecated( "Please use Js.Float.toString instead, string_of_float generates unparseable floats" ) /** Return the string representation of a floating-point number. */ @@ -673,7 +673,7 @@ external snd: (('a, 'b)) => 'b = "%field1" More list operations are provided in module {!List}. ") -@ocaml.deprecated("Use Belt.List.concat instead") +@deprecated("Use Belt.List.concat instead") /** List concatenation. Tail-recursive (length of the first argument). Right-associative operator at precedence level 5/11. */ let \"@": (list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/pervasivesU.resi b/jscomp/stdlib-406/pervasivesU.resi index b1457626aa..bc7c204743 100644 --- a/jscomp/stdlib-406/pervasivesU.resi +++ b/jscomp/stdlib-406/pervasivesU.resi @@ -634,7 +634,7 @@ external int_of_string: string => int = "?int_of_string" */ let int_of_string_opt: string => option -@ocaml.deprecated( +@deprecated( "Please use Js.Float.toString instead, string_of_float generates unparseable floats" ) /** Return the string representation of a floating-point number. */ @@ -675,7 +675,7 @@ external snd: (('a, 'b)) => 'b = "%field1" More list operations are provided in module {!List}. */ -@ocaml.deprecated("Use Belt.List.concat instead") +@deprecated("Use Belt.List.concat instead") /** List concatenation. Tail-recursive (length of the first argument). Right-associative operator at precedence level 5/11. */ let \"@": (list<'a>, list<'a>) => list<'a> diff --git a/jscomp/stdlib-406/sort.resi b/jscomp/stdlib-406/sort.resi index 6944a7e835..d3955e983b 100644 --- a/jscomp/stdlib-406/sort.resi +++ b/jscomp/stdlib-406/sort.resi @@ -21,13 +21,13 @@ The new functions are faster and use less memory. ") -@ocaml.deprecated("Use List.sort instead.") +@deprecated("Use List.sort instead.") /** Sort a list in increasing order according to an ordering predicate. The predicate should return [true] if its first argument is less than or equal to its second argument. */ let list: (('a, 'a) => bool, list<'a>) => list<'a> -@ocaml.deprecated("Use Array.sort instead.") +@deprecated("Use Array.sort instead.") /** Sort an array in increasing order according to an ordering predicate. The predicate should return [true] if its first argument is @@ -35,7 +35,7 @@ let list: (('a, 'a) => bool, list<'a>) => list<'a> The array is sorted in place. */ let array: (('a, 'a) => bool, array<'a>) => unit -@ocaml.deprecated("Use List.merge instead.") +@deprecated("Use List.merge instead.") /** Merge two lists according to the given predicate. Assuming the two argument lists are sorted according to the predicate, [merge] returns a sorted list containing the elements From 902043b144dc98f621b5d762f7345bc970baab97 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Mon, 7 Aug 2023 12:20:35 +0200 Subject: [PATCH 6/9] Fix module-level comments --- jscomp/stdlib-406/array.resi | 45 ++++++++++---------- jscomp/stdlib-406/arrayLabels.resi | 44 +++++++++---------- jscomp/stdlib-406/buffer.resi | 6 +-- jscomp/stdlib-406/bytes.resi | 12 +++--- jscomp/stdlib-406/bytesLabels.resi | 8 ++-- jscomp/stdlib-406/callback.resi | 6 +-- jscomp/stdlib-406/camlinternalLazy.resi | 6 +-- jscomp/stdlib-406/camlinternalMod.resi | 6 +-- jscomp/stdlib-406/char.resi | 34 +++++++-------- jscomp/stdlib-406/complex.resi | 6 +-- jscomp/stdlib-406/digest.resi | 6 +-- jscomp/stdlib-406/filename.resi | 34 +++++++-------- jscomp/stdlib-406/genlex.resi | 6 +-- jscomp/stdlib-406/hashtbl.resi | 16 +++---- jscomp/stdlib-406/int32.resi | 4 +- jscomp/stdlib-406/int64.resi | 10 ++--- jscomp/stdlib-406/lazy.resi | 34 +++++++-------- jscomp/stdlib-406/lexing.resi | 56 +++++++++++-------------- jscomp/stdlib-406/list.res | 18 ++++---- jscomp/stdlib-406/list.resi | 20 ++++----- jscomp/stdlib-406/listLabels.res | 19 ++++----- jscomp/stdlib-406/listLabels.resi | 20 ++++----- jscomp/stdlib-406/map.resi | 6 +-- jscomp/stdlib-406/moreLabels.resi | 6 +-- jscomp/stdlib-406/obj.resi | 13 +++--- jscomp/stdlib-406/parsing.resi | 42 ++++++++----------- jscomp/stdlib-406/pervasives.resi | 55 +++++++++++------------- jscomp/stdlib-406/pervasivesU.resi | 4 +- jscomp/stdlib-406/queue.resi | 6 +-- jscomp/stdlib-406/random.resi | 46 ++++++++++---------- jscomp/stdlib-406/set.resi | 6 +-- jscomp/stdlib-406/sort.resi | 6 +-- jscomp/stdlib-406/stack.resi | 6 +-- jscomp/stdlib-406/stdLabels.resi | 6 +-- jscomp/stdlib-406/stream.resi | 44 +++++++++---------- jscomp/stdlib-406/string.resi | 9 ++-- jscomp/stdlib-406/stringLabels.resi | 36 +++++++--------- jscomp/stdlib-406/sys.resi | 12 +++--- jscomp/stdlib-406/uchar.resi | 10 ++--- 39 files changed, 332 insertions(+), 397 deletions(-) diff --git a/jscomp/stdlib-406/array.resi b/jscomp/stdlib-406/array.resi index 57aa3efdd8..3a725b9e7e 100644 --- a/jscomp/stdlib-406/array.resi +++ b/jscomp/stdlib-406/array.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ - - " Array operations. " -) +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Array operations. */ /** Return the length (number of elements) of the given array. */ external length: array<'a> => int = "%array_length" @@ -135,7 +133,7 @@ let to_list: array<'a> => list<'a> of [l]. */ let of_list: list<'a> => array<'a> -@@ocaml.text(" {1 Iterators} ") +/* {1 Iterators} */ /** [Array.iter f a] applies function [f] in turn to all the elements of [a]. It is equivalent to @@ -167,7 +165,7 @@ let fold_left: (('a, 'b) => 'a, 'a, array<'b>) => 'a where [n] is the length of the array [a]. */ let fold_right: (('b, 'a) => 'a, array<'b>, 'a) => 'a -@@ocaml.text(" {1 Iterators on two arrays} ") +/* {1 Iterators on two arrays} */ /** [Array.iter2 f a b] applies function [f] to all the elements of [a] and [b]. @@ -182,7 +180,7 @@ let iter2: (('a, 'b) => unit, array<'a>, array<'b>) => unit @since 4.03.0 */ let map2: (('a, 'b) => 'c, array<'a>, array<'b>) => array<'c> -@@ocaml.text(" {1 Array scanning} ") +/* {1 Array scanning} */ /** [Array.for_all p [|a1; ...; an|]] checks if all elements of the array satisfy the predicate [p]. That is, it returns @@ -206,7 +204,7 @@ let mem: ('a, array<'a>) => bool @since 4.03.0 */ let memq: ('a, array<'a>) => bool -@@ocaml.text(" {1 Sorting} ") +/* {1 Sorting} */ /** Sort an array in increasing order according to a comparison function. The comparison function must return 0 if its arguments @@ -249,8 +247,7 @@ let stable_sort: (('a, 'a) => int, array<'a>) => unit */ let fast_sort: (('a, 'a) => int, array<'a>) => unit -@@ocaml.text("/*") -@@ocaml.text(" {1 Undocumented functions} ") +/* {1 Undocumented functions} */ /* The following is for system use only. Do not call directly. */ diff --git a/jscomp/stdlib-406/arrayLabels.resi b/jscomp/stdlib-406/arrayLabels.resi index ca0e9d093c..02733ec3aa 100644 --- a/jscomp/stdlib-406/arrayLabels.resi +++ b/jscomp/stdlib-406/arrayLabels.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ - - " Array operations. " -) +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/*** Array operations. */ /** Return the length (number of elements) of the given array. */ external length: array<'a> => int = "%array_length" @@ -157,7 +155,7 @@ let fold_left: (~f: ('a, 'b) => 'a, ~init: 'a, array<'b>) => 'a where [n] is the length of the array [a]. */ let fold_right: (~f: ('b, 'a) => 'a, array<'b>, ~init: 'a) => 'a -@@ocaml.text(" {6 Iterators on two arrays} ") +/* {6 Iterators on two arrays} */ /** [Array.iter2 f a b] applies function [f] to all the elements of [a] and [b]. @@ -172,7 +170,7 @@ let iter2: (~f: ('a, 'b) => unit, array<'a>, array<'b>) => unit @since 4.05.0 */ let map2: (~f: ('a, 'b) => 'c, array<'a>, array<'b>) => array<'c> -@@ocaml.text(" {6 Array scanning} ") +/* {6 Array scanning} */ /** [Array.exists p [|a1; ...; an|]] checks if at least one element of the array satisfies the predicate [p]. That is, it returns @@ -206,7 +204,7 @@ external create_float: int => array = "?make_float_vect" {!Array.create_float}. */ let make_float: int => array -@@ocaml.text(" {1 Sorting} ") +/* {1 Sorting} */ /** Sort an array in increasing order according to a comparison function. The comparison function must return 0 if its arguments @@ -249,9 +247,7 @@ let stable_sort: (~cmp: ('a, 'a) => int, array<'a>) => unit */ let fast_sort: (~cmp: ('a, 'a) => int, array<'a>) => unit -@@ocaml.text("/*") - -@@ocaml.text(" {1 Undocumented functions} ") +/* {1 Undocumented functions} */ /* The following is for system use only. Do not call directly. */ diff --git a/jscomp/stdlib-406/buffer.resi b/jscomp/stdlib-406/buffer.resi index 228731ae51..9929a1d2ff 100644 --- a/jscomp/stdlib-406/buffer.resi +++ b/jscomp/stdlib-406/buffer.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,13 +13,13 @@ /* */ /* ************************************************************************ */ -" Extensible buffers. +/*** Extensible buffers. This module implements buffers that automatically expand as necessary. It provides accumulative concatenation of strings in quasi-linear time (instead of quadratic time when strings are concatenated pairwise). -") +*/ /** The abstract type of buffers. */ type t diff --git a/jscomp/stdlib-406/bytes.resi b/jscomp/stdlib-406/bytes.resi index 81ceaf12f3..d168d923cd 100644 --- a/jscomp/stdlib-406/bytes.resi +++ b/jscomp/stdlib-406/bytes.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" Byte sequence operations. +/*** Byte sequence operations. A byte sequence is a mutable data structure that contains a fixed-length sequence of bytes. Each byte can be indexed in @@ -40,7 +40,7 @@ Bytes are represented by the OCaml type [char]. @since 4.02.0 - ") +*/ /** Return the length (number of bytes) of the argument. */ external length: bytes => int = "%bytes_length" @@ -292,7 +292,7 @@ let compare: (t, t) => int @since 4.03.0 */ let equal: (t, t) => bool -@@ocaml.text(" {3 Unsafe conversions (for advanced users)} +/* {3 Unsafe conversions (for advanced users)} This section describes unsafe, low-level conversion functions between [bytes] and [string]. They do not copy the internal data; @@ -300,7 +300,7 @@ let equal: (t, t) => bool strings provided by the [-safe-string] option. They are available for expert library authors, but for most purposes you should use the always-correct {!Bytes.to_string} and {!Bytes.of_string} instead. -") +*/ /** Unsafely convert a byte sequence into a string. @@ -421,8 +421,6 @@ let s = Bytes.of_string \"hello\" */ let unsafe_of_string: string => bytes -@@ocaml.text("/*") - /* The following is for system use only. Do not call directly. */ external unsafe_get: (bytes, int) => char = "%bytes_unsafe_get" diff --git a/jscomp/stdlib-406/bytesLabels.resi b/jscomp/stdlib-406/bytesLabels.resi index 40af0415a4..411f939e20 100644 --- a/jscomp/stdlib-406/bytesLabels.resi +++ b/jscomp/stdlib-406/bytesLabels.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,9 +13,9 @@ /* */ /* ************************************************************************ */ -" Byte sequence operations. +/*** Byte sequence operations. @since 4.02.0 - ") +*/ /** Return the length (number of bytes) of the argument. */ external length: bytes => int = "%bytes_length" @@ -261,8 +261,6 @@ let compare: (t, t) => int @since 4.05.0 */ let equal: (t, t) => bool -@@ocaml.text("/*") - /* The following is for system use only. Do not call directly. */ external unsafe_get: (bytes, int) => char = "%bytes_unsafe_get" diff --git a/jscomp/stdlib-406/callback.resi b/jscomp/stdlib-406/callback.resi index 56cc36bad5..bff728306d 100644 --- a/jscomp/stdlib-406/callback.resi +++ b/jscomp/stdlib-406/callback.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,12 +13,12 @@ /* */ /* ************************************************************************ */ -" Registering OCaml values with the C runtime. +/*** Registering OCaml values with the C runtime. This module allows OCaml values to be registered with the C runtime under a symbolic name, so that C code can later call back registered OCaml functions, or raise registered OCaml exceptions. -") +*/ /** [Callback.register n v] registers the value [v] under the name [n]. C code can later retrieve a handle to [v] diff --git a/jscomp/stdlib-406/camlinternalLazy.resi b/jscomp/stdlib-406/camlinternalLazy.resi index 47944ef698..82e0be301d 100644 --- a/jscomp/stdlib-406/camlinternalLazy.resi +++ b/jscomp/stdlib-406/camlinternalLazy.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,9 +13,9 @@ /* */ /* ************************************************************************ */ -" Run-time support for lazy values. +/*** Run-time support for lazy values. All functions in this module are for system use only, not for the - casual user. ") + casual user. */ exception Undefined diff --git a/jscomp/stdlib-406/camlinternalMod.resi b/jscomp/stdlib-406/camlinternalMod.resi index b4da437d52..e5529a4d5c 100644 --- a/jscomp/stdlib-406/camlinternalMod.resi +++ b/jscomp/stdlib-406/camlinternalMod.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,9 +13,9 @@ /* */ /* ************************************************************************ */ -" Run-time support for recursive modules. +/*** Run-time support for recursive modules. All functions in this module are for system use only, not for the - casual user. ") + casual user. */ type rec shape = | Function diff --git a/jscomp/stdlib-406/char.resi b/jscomp/stdlib-406/char.resi index e42e0f0d2d..58da9b7a5e 100644 --- a/jscomp/stdlib-406/char.resi +++ b/jscomp/stdlib-406/char.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1996 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ - " Character operations. " -) +/*** Character operations. */ /** Return the ASCII code of the argument. */ external code: char => int = "%identity" @@ -67,8 +65,6 @@ let compare: (t, t) => int @since 4.03.0 */ let equal: (t, t) => bool -@@ocaml.text("/*") - /* The following is for system use only. Do not call directly. */ external unsafe_chr: int => char = "%identity" diff --git a/jscomp/stdlib-406/complex.resi b/jscomp/stdlib-406/complex.resi index 6b89d3c80e..bacdc477d5 100644 --- a/jscomp/stdlib-406/complex.resi +++ b/jscomp/stdlib-406/complex.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,12 +13,12 @@ /* */ /* ************************************************************************ */ -" Complex numbers. +/*** Complex numbers. This module provides arithmetic operations on complex numbers. Complex numbers are represented by their real and imaginary parts (cartesian representation). Each part is represented by a - double-precision floating-point number (type [float]). ") + double-precision floating-point number (type [float]). */ /** The type of complex numbers. [re] is the real part and [im] the imaginary part. */ diff --git a/jscomp/stdlib-406/digest.resi b/jscomp/stdlib-406/digest.resi index dd6dfd3690..bcedb527e5 100644 --- a/jscomp/stdlib-406/digest.resi +++ b/jscomp/stdlib-406/digest.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" MD5 message digest. +/*** MD5 message digest. This module provides functions to compute 128-bit 'digests' of arbitrary-length strings or files. The digests are of cryptographic @@ -22,7 +22,7 @@ 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 diff --git a/jscomp/stdlib-406/filename.resi b/jscomp/stdlib-406/filename.resi index 0c3af74187..cf5037bc17 100644 --- a/jscomp/stdlib-406/filename.resi +++ b/jscomp/stdlib-406/filename.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ - - " Operations on file names. " -) +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* Operations on file names. */ /** The conventional name for the current directory (e.g. [.] in Unix). */ let current_dir_name: string diff --git a/jscomp/stdlib-406/genlex.resi b/jscomp/stdlib-406/genlex.resi index c1179cbd12..c91885fadf 100644 --- a/jscomp/stdlib-406/genlex.resi +++ b/jscomp/stdlib-406/genlex.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" A generic lexical analyzer. +/*** A generic lexical analyzer. This module implements a simple 'standard' lexical analyzer, presented @@ -43,7 +43,7 @@ notation for streams are only available through camlp4 extensions. This means that one has to preprocess its sources {i e. g.} by using the [\"-pp\"] command-line switch of the compilers. -") +*/ /** The type of tokens. The lexical classes are: [Int] and [Float] for integer and floating-point numbers; [String] for diff --git a/jscomp/stdlib-406/hashtbl.resi b/jscomp/stdlib-406/hashtbl.resi index 861a679569..64c33f7066 100644 --- a/jscomp/stdlib-406/hashtbl.resi +++ b/jscomp/stdlib-406/hashtbl.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,12 +13,12 @@ /* */ /* ************************************************************************ */ -" Hash tables and hash functions. +/*** Hash tables and hash functions. Hash tables are hashed association tables, with in-place modification. -") +*/ -@@ocaml.text(" {1 Generic interface} ") +/* {1 Generic interface} */ /** The type of hash tables from type ['a] to type ['b]. */ type t<'a, 'b> @@ -214,9 +214,9 @@ type statistics = { @since 4.00.0 */ let stats: t<'a, 'b> => statistics -@@ocaml.text(" {1 Functorial interface} ") +/* {1 Functorial interface} -@@ocaml.text(" The functorial interface allows the use of specific comparison +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. @@ -243,7 +243,7 @@ let stats: t<'a, 'b> => statistics 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 = { @@ -367,7 +367,7 @@ module type SeededS = { @since 4.00.0 */ module MakeSeeded: (H: SeededHashedType) => (SeededS with type key = H.t) -@@ocaml.text(" {1 The polymorphic hash functions} ") +/* {1 The polymorphic hash functions} */ /** [Hashtbl.hash x] associates a nonnegative integer to any value of any type. It is guaranteed that diff --git a/jscomp/stdlib-406/int32.resi b/jscomp/stdlib-406/int32.resi index f63c5fa3a6..4193a77919 100644 --- a/jscomp/stdlib-406/int32.resi +++ b/jscomp/stdlib-406/int32.resi @@ -169,9 +169,7 @@ let compare: (t, t) => int @since 4.03.0 */ let equal: (t, t) => bool -@@ocaml.text("/*") - -@@ocaml.text(" {1 Deprecated functions} ") +/* {1 Deprecated functions} */ /** Do not use this deprecated function. Instead, used {!Printf.sprintf} with a [%l...] format. */ diff --git a/jscomp/stdlib-406/int64.resi b/jscomp/stdlib-406/int64.resi index 55e4e57056..a0e3629ef4 100644 --- a/jscomp/stdlib-406/int64.resi +++ b/jscomp/stdlib-406/int64.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" 64-bit integers. +/*** 64-bit integers. This module provides operations on the type [int64] of signed 64-bit integers. Unlike the built-in [int] type, @@ -25,7 +25,7 @@ space than values of type [int], and arithmetic operations on [int64] are generally slower than those on [int]. Use [int64] only when the application requires exact 64-bit arithmetic. -") +*/ /** The 64-bit integer 0. */ let zero: int64 @@ -182,9 +182,7 @@ let compare: (t, t) => int @since 4.03.0 */ let equal: (t, t) => bool -@@ocaml.text("/*") - -@@ocaml.text(" {1 Deprecated functions} ") +/* {1 Deprecated functions} */ /** Do not use this deprecated function. Instead, used {!Printf.sprintf} with a [%L...] format. */ diff --git a/jscomp/stdlib-406/lazy.resi b/jscomp/stdlib-406/lazy.resi index 594b8e4b88..1dcb388285 100644 --- a/jscomp/stdlib-406/lazy.resi +++ b/jscomp/stdlib-406/lazy.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* OCaml */ - /* */ - /* Damien Doligez, projet Para, INRIA Rocquencourt */ - /* */ - /* Copyright 1997 Institut National de Recherche en Informatique et */ - /* en Automatique. */ - /* */ - /* All rights reserved. This file is distributed under the terms of */ - /* the GNU Lesser General Public License version 2.1, with the */ - /* special exception on linking described in the file LICENSE. */ - /* */ - /* ************************************************************************ */ - - " Deferred computations. " -) +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +/*** Deferred computations. */ /** A value of type ['a Lazy.t] is a deferred computation, called a suspension, that has a result of type ['a]. The special diff --git a/jscomp/stdlib-406/lexing.resi b/jscomp/stdlib-406/lexing.resi index 6c3c857fa2..9a84781324 100644 --- a/jscomp/stdlib-406/lexing.resi +++ b/jscomp/stdlib-406/lexing.resi @@ -1,23 +1,21 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ - - " The run-time library for lexers generated by [ocamllex]. " -) - -@@ocaml.text(" {1 Positions} ") +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/*** The run-time library for lexers generated by [ocamllex]. */ + +/* {1 Positions} */ /** A value of type [position] describes a point in a source file. [pos_fname] is the file name; [pos_lnum] is the line number; @@ -44,7 +42,7 @@ type position = { */ let dummy_pos: position -@@ocaml.text(" {1 Lexer buffers} ") +/* {1 Lexer buffers} */ /** The type of lexer buffers. A lexer buffer is the argument passed to the scanning functions defined by the generated scanners. @@ -89,16 +87,16 @@ let from_string: string => lexbuf provided. A return value of 0 means end of input. */ let from_function: ((bytes, int) => int) => lexbuf -@@ocaml.text(" {1 Functions for lexer semantic actions} ") +/* {1 Functions for lexer semantic actions} */ -@@ocaml.text(" The following functions can be called from the semantic actions +/* The following functions can be called from the semantic actions of lexer definitions (the ML code enclosed in braces that computes the value returned by lexing functions). They give access to the character string matched by the regular expression associated with the semantic action. These functions must be applied to the argument [lexbuf], which, in the code generated by [ocamllex], is bound to the lexer buffer passed to the parsing - function. ") + function. */ /** [Lexing.lexeme lexbuf] returns the string matched by the regular expression. */ @@ -133,19 +131,15 @@ let lexeme_end_p: lexbuf => position */ let new_line: lexbuf => unit -@@ocaml.text(" {1 Miscellaneous functions} ") +/* {1 Miscellaneous functions} */ /** Discard the contents of the buffer and reset the current position to 0. The next use of the lexbuf will trigger a refill. */ let flush_input: lexbuf => unit -@@ocaml.text("/*") - -@@ocaml.text(" {1 } ") - -@@ocaml.text(" The following definitions are used by the generated scanners only. - They are not intended to be used directly by user programs. ") +/* The following definitions are used by the generated scanners only. + They are not intended to be used directly by user programs. */ let sub_lexeme: (lexbuf, int, int) => string let sub_lexeme_opt: (lexbuf, int, int) => option diff --git a/jscomp/stdlib-406/list.res b/jscomp/stdlib-406/list.res index ae40d401cd..c8ae708a4e 100644 --- a/jscomp/stdlib-406/list.res +++ b/jscomp/stdlib-406/list.res @@ -397,7 +397,7 @@ let rec combine = (l1, l2) => | (_, _) => invalid_arg("List.combine") } -@@ocaml.text(" sorting ") +/* sorting */ let rec merge = (cmp, l1, l2) => switch (l1, l2) { @@ -522,14 +522,13 @@ let stable_sort = (cmp, l) => { let sort = stable_sort let fast_sort = stable_sort -@@ocaml.text( - /* Note: on a list of length between about 100000 (depending on the minor - heap size and the type of the list) and Sys.max_array_size, it is - actually faster to use the following, but it might also use more memory - because the argument list cannot be deallocated incrementally. +/* Note: on a list of length between about 100000 (depending on the minor + heap size and the type of the list) and Sys.max_array_size, it is + actually faster to use the following, but it might also use more memory + because the argument list cannot be deallocated incrementally. - Also, there seems to be a bug in this code or in the - implementation of obj_truncate. + Also, there seems to be a bug in this code or in the + implementation of obj_truncate. external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" @@ -555,8 +554,7 @@ let stable_sort cmp l = */ - " sorting + removing duplicates " -) +/* sorting + removing duplicates */ let sort_uniq = (cmp, l) => { let rec rev_merge = (l1, l2, accu) => diff --git a/jscomp/stdlib-406/list.resi b/jscomp/stdlib-406/list.resi index 2254165aa7..3c3d04e9ea 100644 --- a/jscomp/stdlib-406/list.resi +++ b/jscomp/stdlib-406/list.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" List operations. +/*** List operations. Some functions are flagged as not tail-recursive. A tail-recursive function uses constant stack space, while a non-tail-recursive function @@ -24,7 +24,7 @@ The above considerations can usually be ignored if your lists are not longer than about 10000 elements. -") +*/ /** Return the length (number of elements) of the given list. */ let length: list<'a> => int @@ -98,7 +98,7 @@ let concat: list> => list<'a> /** An alias for [concat]. */ let flatten: list> => list<'a> -@@ocaml.text(" {1 Iterators} ") +/* {1 Iterators} */ /** [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an]. It is equivalent to @@ -137,7 +137,7 @@ let fold_left: (('a, 'b) => 'a, 'a, list<'b>) => 'a [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. */ let fold_right: (('a, 'b) => 'b, list<'a>, 'b) => 'b -@@ocaml.text(" {1 Iterators on two lists} ") +/* {1 Iterators on two lists} */ /** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn]. @@ -168,7 +168,7 @@ let fold_left2: (('a, 'b, 'c) => 'a, 'a, list<'b>, list<'c>) => 'a to have different lengths. Not tail-recursive. */ let fold_right2: (('a, 'b, 'c) => 'c, list<'a>, list<'b>, 'c) => 'c -@@ocaml.text(" {1 List scanning} ") +/* {1 List scanning} */ /** [for_all p [a1; ...; an]] checks if all elements of the list satisfy the predicate [p]. That is, it returns @@ -198,7 +198,7 @@ let mem: ('a, list<'a>) => bool equality to compare list elements. */ let memq: ('a, list<'a>) => bool -@@ocaml.text(" {1 List searching} ") +/* {1 List searching} */ /** [find p l] returns the first element of the list [l] that satisfies the predicate [p]. @@ -227,7 +227,7 @@ let find_all: ('a => bool, list<'a>) => list<'a> The order of the elements in the input list is preserved. */ let partition: ('a => bool, list<'a>) => (list<'a>, list<'a>) -@@ocaml.text(" {1 Association lists} ") +/* {1 Association lists} */ /** [assoc a l] returns the value associated with key [a] in the list of pairs [l]. That is, @@ -272,7 +272,7 @@ let remove_assoc: ('a, list<('a, 'b)>) => list<('a, 'b)> of structural equality to compare keys. Not tail-recursive. */ let remove_assq: ('a, list<('a, 'b)>) => list<('a, 'b)> -@@ocaml.text(" {1 Lists of pairs} ") +/* {1 Lists of pairs} */ /** Transform a list of pairs into a pair of lists: [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. @@ -287,7 +287,7 @@ let split: list<('a, 'b)> => (list<'a>, list<'b>) have different lengths. Not tail-recursive. */ let combine: (list<'a>, list<'b>) => list<('a, 'b)> -@@ocaml.text(" {1 Sorting} ") +/* {1 Sorting} */ /** Sort a list in increasing order according to a comparison function. The comparison function must return 0 if its arguments diff --git a/jscomp/stdlib-406/listLabels.res b/jscomp/stdlib-406/listLabels.res index 969cfd107c..48d46d97fe 100644 --- a/jscomp/stdlib-406/listLabels.res +++ b/jscomp/stdlib-406/listLabels.res @@ -397,7 +397,7 @@ let rec combine = (l1, l2) => | (_, _) => invalid_arg("List.combine") } -@@ocaml.text(" sorting ") +/* sorting */ let rec merge = (~cmp, l1, l2) => switch (l1, l2) { @@ -522,14 +522,13 @@ let stable_sort = (~cmp, l) => { let sort = stable_sort let fast_sort = stable_sort -@@ocaml.text( - /* Note: on a list of length between about 100000 (depending on the minor - heap size and the type of the list) and Sys.max_array_size, it is - actually faster to use the following, but it might also use more memory - because the argument list cannot be deallocated incrementally. +/* Note: on a list of length between about 100000 (depending on the minor + heap size and the type of the list) and Sys.max_array_size, it is + actually faster to use the following, but it might also use more memory + because the argument list cannot be deallocated incrementally. - Also, there seems to be a bug in this code or in the - implementation of obj_truncate. + Also, there seems to be a bug in this code or in the + implementation of obj_truncate. external obj_truncate : 'a array -> int -> unit = "caml_obj_truncate" @@ -552,11 +551,9 @@ let stable_sort cmp l = let a = Array.of_list l in Array.stable_sort cmp a; array_to_list_in_place a - */ - " sorting + removing duplicates " -) +/* sorting + removing duplicates */ let sort_uniq = (~cmp, l) => { let rec rev_merge = (l1, l2, accu) => diff --git a/jscomp/stdlib-406/listLabels.resi b/jscomp/stdlib-406/listLabels.resi index 23b3ca9062..3f9a3faf71 100644 --- a/jscomp/stdlib-406/listLabels.resi +++ b/jscomp/stdlib-406/listLabels.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" List operations. +/*** List operations. Some functions are flagged as not tail-recursive. A tail-recursive function uses constant stack space, while a non-tail-recursive function @@ -24,7 +24,7 @@ The above considerations can usually be ignored if your lists are not longer than about 10000 elements. -") +*/ /** Return the length (number of elements) of the given list. */ let length: list<'a> => int @@ -100,7 +100,7 @@ let concat: list> => list<'a> (length of the argument + length of the longest sub-list). */ let flatten: list> => list<'a> -@@ocaml.text(" {1 Iterators} ") +/* {1 Iterators} */ /** [List.iter f [a1; ...; an]] applies function [f] in turn to [a1; ...; an]. It is equivalent to @@ -139,7 +139,7 @@ let fold_left: (~f: ('a, 'b) => 'a, ~init: 'a, list<'b>) => 'a [f a1 (f a2 (... (f an b) ...))]. Not tail-recursive. */ let fold_right: (~f: ('a, 'b) => 'b, list<'a>, ~init: 'b) => 'b -@@ocaml.text(" {1 Iterators on two lists} ") +/* {1 Iterators on two lists} */ /** [List.iter2 f [a1; ...; an] [b1; ...; bn]] calls in turn [f a1 b1; ...; f an bn]. @@ -170,7 +170,7 @@ let fold_left2: (~f: ('a, 'b, 'c) => 'a, ~init: 'a, list<'b>, list<'c>) => 'a to have different lengths. Not tail-recursive. */ let fold_right2: (~f: ('a, 'b, 'c) => 'c, list<'a>, list<'b>, ~init: 'c) => 'c -@@ocaml.text(" {1 List scanning} ") +/* {1 List scanning} */ /** [for_all p [a1; ...; an]] checks if all elements of the list satisfy the predicate [p]. That is, it returns @@ -200,7 +200,7 @@ let mem: ('a, ~set: list<'a>) => bool equality to compare list elements. */ let memq: ('a, ~set: list<'a>) => bool -@@ocaml.text(" {1 List searching} ") +/* {1 List searching} */ /** [find p l] returns the first element of the list [l] that satisfies the predicate [p]. @@ -230,7 +230,7 @@ let find_all: (~f: 'a => bool, list<'a>) => list<'a> The order of the elements in the input list is preserved. */ let partition: (~f: 'a => bool, list<'a>) => (list<'a>, list<'a>) -@@ocaml.text(" {1 Association lists} ") +/* {1 Association lists} */ /** [assoc a l] returns the value associated with key [a] in the list of pairs [l]. That is, @@ -276,7 +276,7 @@ let remove_assoc: ('a, list<('a, 'b)>) => list<('a, 'b)> of structural equality to compare keys. Not tail-recursive. */ let remove_assq: ('a, list<('a, 'b)>) => list<('a, 'b)> -@@ocaml.text(" {1 Lists of pairs} ") +/* {1 Lists of pairs} */ /** Transform a list of pairs into a pair of lists: [split [(a1,b1); ...; (an,bn)]] is [([a1; ...; an], [b1; ...; bn])]. @@ -291,7 +291,7 @@ let split: list<('a, 'b)> => (list<'a>, list<'b>) have different lengths. Not tail-recursive. */ let combine: (list<'a>, list<'b>) => list<('a, 'b)> -@@ocaml.text(" {1 Sorting} ") +/* {1 Sorting} */ /** Sort a list in increasing order according to a comparison function. The comparison function must return 0 if its arguments diff --git a/jscomp/stdlib-406/map.resi b/jscomp/stdlib-406/map.resi index 74288e6db3..11458cb69a 100644 --- a/jscomp/stdlib-406/map.resi +++ b/jscomp/stdlib-406/map.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" Association tables over ordered types. +/*** Association tables over ordered types. This module implements applicative association tables, also known as finite maps or dictionaries, given a total ordering function @@ -41,7 +41,7 @@ This creates a new module [PairsMap], with a new type ['a PairsMap.t] of maps from [int * int] to ['a]. In this example, [m] contains [string] values so its type is [string PairsMap.t]. -") +*/ /** Input signature of the functor {!Map.Make}. */ module type OrderedType = { diff --git a/jscomp/stdlib-406/moreLabels.resi b/jscomp/stdlib-406/moreLabels.resi index a93e011b3e..397641d669 100644 --- a/jscomp/stdlib-406/moreLabels.resi +++ b/jscomp/stdlib-406/moreLabels.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" Extra labeled libraries. +/*** Extra labeled libraries. This meta-module provides labelized version of the {!Hashtbl}, {!Map} and {!Set} modules. @@ -21,7 +21,7 @@ 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> diff --git a/jscomp/stdlib-406/obj.resi b/jscomp/stdlib-406/obj.resi index cfc78accbe..28bb95487c 100644 --- a/jscomp/stdlib-406/obj.resi +++ b/jscomp/stdlib-406/obj.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,10 +13,10 @@ /* */ /* ************************************************************************ */ -" Operations on internal representations of values. +/*** Operations on internal representations of values. Not for the casual user. -") +*/ type t @@ -26,15 +26,14 @@ external magic: 'a => 'b = "%identity" @inline(always) let is_block: t => bool external tag: t => int = "?obj_tag" -external size: t => int = "#obj_length" - -@@ocaml.text(" +/** Computes the total size (in words, including the headers) of all heap blocks accessible from the argument. Statically allocated blocks are excluded. @Since 4.04 - ") +*/ +external size: t => int = "#obj_length" external field: (t, int) => t = "%obj_field" diff --git a/jscomp/stdlib-406/parsing.resi b/jscomp/stdlib-406/parsing.resi index afe853bff6..f93fd0fcd1 100644 --- a/jscomp/stdlib-406/parsing.resi +++ b/jscomp/stdlib-406/parsing.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ - - " The run-time library for parsers generated by [ocamlyacc]. " -) +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/* The run-time library for parsers generated by [ocamlyacc]. */ /** [symbol_start] and {!Parsing.symbol_end} are to be called in the action part of a grammar rule only. They return the offset of the @@ -71,12 +69,8 @@ exception Parse_error */ let set_trace: bool => bool -@@ocaml.text("/*") - -@@ocaml.text(" {1 } ") - -@@ocaml.text(" The following definitions are used by the generated parsers only. - They are not intended to be used directly by user programs. ") +/* The following definitions are used by the generated parsers only. + They are not intended to be used directly by user programs. */ type parser_env diff --git a/jscomp/stdlib-406/pervasives.resi b/jscomp/stdlib-406/pervasives.resi index 7b27b406f8..83673a42ed 100644 --- a/jscomp/stdlib-406/pervasives.resi +++ b/jscomp/stdlib-406/pervasives.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" The initially opened module. +/*** The initially opened module. This module provides the basic operations over the built-in types (numbers, booleans, byte sequences, strings, exceptions, references, @@ -22,7 +22,7 @@ This module is automatically opened at the beginning of each compilation. All components of this module can therefore be referred by their short name, without prefixing them by [Pervasives]. -") +*/ module Jsx = JsxC module JsxEvent = JsxEventC @@ -39,8 +39,7 @@ module JsxModules: { /* Internal */ external __unsafe_cast: 'a => 'b = "%identity" - -@@ocaml.text(" {1 Exceptions} ") +/* 1 Exceptions} */ /** Raise the given exception value */ external raise: exn => 'a = "%raise" @@ -60,7 +59,7 @@ let failwith: string => 'a provided for use in your programs. */ exception Exit -@@ocaml.text(" {1 Comparisons} ") +/* {1 Comparisons} */ /** [e1 = e2] tests for structural equality of [e1] and [e2]. Mutable structures (e.g. references and arrays) are equal @@ -142,7 +141,7 @@ external \"==": ('a, 'a) => bool = "%eq" Left-associative operator at precedence level 4/11. */ external \"!=": ('a, 'a) => bool = "%noteq" -@@ocaml.text(" {1 Boolean operations} ") +/* {1 Boolean operations} */ /** The boolean negation. */ external not: bool => bool = "%boolnot" @@ -160,7 +159,7 @@ external \"&&": (bool, bool) => bool = "%sequand" */ external \"||": (bool, bool) => bool = "%sequor" -@@ocaml.text(" {1 Debugging} ") +/* {1 Debugging} */ /** [__LOC__] returns the location at which this expression appears in the file currently being parsed by the compiler, with the standard @@ -221,7 +220,7 @@ external __LINE_OF__: 'a => (int, 'a) = "%loc_LINE" */ external __POS_OF__: 'a => ((string, int, int, int), 'a) = "%loc_POS" -@@ocaml.text(" {1 Composition operators} ") +/* {1 Composition operators} */ /** Reverse-application operator: [x |> f |> g] is exactly equivalent to [g (f (x))]. @@ -237,11 +236,11 @@ external \"|>": ('a, 'a => 'b) => 'b = "%revapply" */ external \"@@": ('a => 'b, 'a) => 'b = "%apply" -@@ocaml.text(" {1 Integer arithmetic} ") +/* {1 Integer arithmetic} */ -@@ocaml.text(" Integers are 31 bits wide (or 63 bits on 64-bit processors). +/* Integers are 31 bits wide (or 63 bits on 64-bit processors). All operations are taken modulo 2{^31} (or 2{^63}). - They do not fail on overflow. ") + They do not fail on overflow. */ /** Unary negation. You can also write [- e] instead of [~- e]. Unary operator at precedence level 9/11 for [- e] @@ -302,7 +301,7 @@ let max_int: int /** The smallest representable integer. */ let min_int: int -@@ocaml.text(" {2 Bitwise operations} ") +/* {2 Bitwise operations} */ /** Bitwise logical and. Left-associative operator at precedence level 7/11. */ @@ -339,7 +338,7 @@ external lsr: (int, int) => int = "%lsrint" Right-associative operator at precedence level 8/11. */ external asr: (int, int) => int = "%asrint" -@@ocaml.text(" {1 Floating-point arithmetic} +/* {1 Floating-point arithmetic} OCaml's floating-point numbers follow the IEEE 754 standard, using double precision (64 bits) numbers. @@ -351,7 +350,7 @@ external asr: (int, int) => int = "%asrint" floating-point computations as expected: for instance, [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan] as argument returns [nan] as result. -") +*/ /** Unary negation. You can also write [-. e] instead of [~-. e]. Unary operator at precedence level 9/11 for [-. e] @@ -564,10 +563,10 @@ let classify_float: float => fpclass Right-associative operator at precedence level 5/11. */ external \"^": (string, string) => string = "#string_append" -@@ocaml.text(" {1 Character operations} +/* {1 Character operations} More character operations are provided in module {!Char}. -") +*/ /** Return the ASCII code of the argument. */ external int_of_char: char => int = "%identity" @@ -577,7 +576,7 @@ external int_of_char: char => int = "%identity" outside the range 0--255. */ let char_of_int: int => char -@@ocaml.text(" {1 Unit operations} ") +/* {1 Unit operations} */ /** Discard the value of its argument and return [()]. For instance, [ignore(f x)] discards the result of @@ -587,7 +586,7 @@ let char_of_int: int => char avoids the warning. */ external ignore: 'a => unit = "%ignore" -@@ocaml.text(" {1 String conversion functions} ") +/* {1 String conversion functions} */ /** Return the string representation of a boolean. As the returned values may be shared, the user should not modify them directly. @@ -632,9 +631,7 @@ external int_of_string: string => int = "?int_of_string" */ let int_of_string_opt: string => option -@deprecated( - "Please use Js.Float.toString instead, string_of_float generates unparseable floats" -) +@deprecated("Please use Js.Float.toString instead, string_of_float generates unparseable floats") /** Return the string representation of a floating-point number. */ let string_of_float: float => string @@ -660,7 +657,7 @@ external float_of_string: string => float = "?float_of_string" */ let float_of_string_opt: string => option -@@ocaml.text(" {1 Pair operations} ") +/* {1 Pair operations} */ /** Return the first component of a pair. */ external fst: (('a, 'b)) => 'a = "%field0" @@ -668,10 +665,10 @@ external fst: (('a, 'b)) => 'a = "%field0" /** Return the second component of a pair. */ external snd: (('a, 'b)) => 'b = "%field1" -@@ocaml.text(" {1 List operations} +/* {1 List operations} More list operations are provided in module {!List}. -") +*/ @deprecated("Use Belt.List.concat instead") /** List concatenation. Tail-recursive (length of the first argument). @@ -711,7 +708,7 @@ external prerr_endline: string => unit = "error" standard error. */ let prerr_newline: unit => unit -@@ocaml.text(" {1 References} ") +/* {1 References} */ /** The type of references (mutable indirection cells) containing a value of type ['a]. */ @@ -738,14 +735,14 @@ external incr: ref => unit = "%incr" Equivalent to [fun r -> r := pred !r]. */ external decr: ref => unit = "%decr" -@@ocaml.text(" {1 Result type} ") +/* {1 Result type} */ /** @since 4.03.0 */ type result<'a, 'b> = Belt.Result.t<'a, 'b> = | Ok('a) | Error('b) -@@ocaml.text(" {1 Program termination} ") +/* {1 Program termination} */ /** Terminate the process, returning the given status code to the operating system: usually 0 to indicate no errors, @@ -767,6 +764,4 @@ let exit: int => 'a function most recently added with [at_exit] is called first. */ let at_exit: (unit => unit) => unit -@@ocaml.text("/*") - let valid_float_lexem: string => string diff --git a/jscomp/stdlib-406/pervasivesU.resi b/jscomp/stdlib-406/pervasivesU.resi index bc7c204743..e51c68be81 100644 --- a/jscomp/stdlib-406/pervasivesU.resi +++ b/jscomp/stdlib-406/pervasivesU.resi @@ -634,9 +634,7 @@ external int_of_string: string => int = "?int_of_string" */ let int_of_string_opt: string => option -@deprecated( - "Please use Js.Float.toString instead, string_of_float generates unparseable floats" -) +@deprecated("Please use Js.Float.toString instead, string_of_float generates unparseable floats") /** Return the string representation of a floating-point number. */ let string_of_float: float => string diff --git a/jscomp/stdlib-406/queue.resi b/jscomp/stdlib-406/queue.resi index 0a8388f233..c5ed5ae64b 100644 --- a/jscomp/stdlib-406/queue.resi +++ b/jscomp/stdlib-406/queue.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,14 +13,14 @@ /* */ /* ************************************************************************ */ -" First-in first-out queues. +/*** First-in first-out queues. This module implements queues (FIFOs), with in-place modification. {b Warning} This module is not thread-safe: each {!Queue.t} value must be protected from concurrent access (e.g. with a [Mutex.t]). Failure to do so can lead to a crash. -") +*/ /** The type of queues containing elements of type ['a]. */ type t<'a> diff --git a/jscomp/stdlib-406/random.resi b/jscomp/stdlib-406/random.resi index 718c789d1b..05624c98eb 100644 --- a/jscomp/stdlib-406/random.resi +++ b/jscomp/stdlib-406/random.resi @@ -1,23 +1,21 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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). " -) - -@@ocaml.text(" {1 Basic functions} ") +/* ************************************************************************ */ +/* */ +/* 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. */ @@ -61,16 +59,16 @@ let float: float => float /** [Random.bool ()] returns [true] or [false] with probability 0.5 each. */ let bool: unit => bool -@@ocaml.text(" {1 Advanced functions} ") +/* {1 Advanced functions} */ -@@ocaml.text(" The functions from module {!State} manipulate the current state +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. -") + */ -module State: { /** The type of PRNG states. */ type t diff --git a/jscomp/stdlib-406/set.resi b/jscomp/stdlib-406/set.resi index b731eb6bba..7d68f7b7c6 100644 --- a/jscomp/stdlib-406/set.resi +++ b/jscomp/stdlib-406/set.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" Sets over ordered types. +/*** Sets over ordered types. This module implements the set data structure, given a total ordering function over the set elements. All operations over sets @@ -42,7 +42,7 @@ This creates a new module [PairsSet], with a new type [PairsSet.t] of sets of [int * int]. -") +*/ /** Input signature of the functor {!Set.Make}. */ module type OrderedType = { diff --git a/jscomp/stdlib-406/sort.resi b/jscomp/stdlib-406/sort.resi index d3955e983b..b4de4f98f0 100644 --- a/jscomp/stdlib-406/sort.resi +++ b/jscomp/stdlib-406/sort.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,13 +13,13 @@ /* */ /* ************************************************************************ */ -" Sorting and merging lists. +/*** Sorting and merging lists. @deprecated This module is obsolete and exists only for backward compatibility. The sorting functions in {!Array} and {!List} should be used instead. The new functions are faster and use less memory. -") +*/ @deprecated("Use List.sort instead.") /** Sort a list in increasing order according to an ordering predicate. diff --git a/jscomp/stdlib-406/stack.resi b/jscomp/stdlib-406/stack.resi index 9fc5e44625..6acaaa7a03 100644 --- a/jscomp/stdlib-406/stack.resi +++ b/jscomp/stdlib-406/stack.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,10 +13,10 @@ /* */ /* ************************************************************************ */ -" Last-in first-out stacks. +/*** Last-in first-out stacks. This module implements stacks (LIFOs), with in-place modification. -") +*/ /** The type of stacks containing elements of type ['a]. */ type t<'a> diff --git a/jscomp/stdlib-406/stdLabels.resi b/jscomp/stdlib-406/stdLabels.resi index 9a377b8bcf..a36e9d33a3 100644 --- a/jscomp/stdlib-406/stdLabels.resi +++ b/jscomp/stdlib-406/stdLabels.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" Standard labeled libraries. +/*** Standard labeled libraries. This meta-module provides labelized version of the {!Array}, {!Bytes}, {!List} and {!String} modules. @@ -21,7 +21,7 @@ They only differ by their labels. Detailed interfaces can be found in [arrayLabels.mli], [bytesLabels.mli], [listLabels.mli] and [stringLabels.mli]. -") +*/ module Array = ArrayLabels module Bytes = BytesLabels diff --git a/jscomp/stdlib-406/stream.resi b/jscomp/stdlib-406/stream.resi index b10c6e5d95..e72e2e1dce 100644 --- a/jscomp/stdlib-406/stream.resi +++ b/jscomp/stdlib-406/stream.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* OCaml */ - /* */ - /* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt */ - /* */ - /* Copyright 1997 Institut National de Recherche en Informatique et */ - /* en Automatique. */ - /* */ - /* All rights reserved. This file is distributed under the terms of */ - /* the GNU Lesser General Public License version 2.1, with the */ - /* special exception on linking described in the file LICENSE. */ - /* */ - /* ************************************************************************ */ - - " Streams and parsers. " -) +/* ************************************************************************ */ +/* */ +/* OCaml */ +/* */ +/* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/* ************************************************************************ */ + +/*** Streams and parsers. */ /** The type of streams holding values of type ['a]. */ type t<'a> @@ -28,7 +26,7 @@ exception Failure accepted, but one of the following components is rejected. */ exception Error(string) -@@ocaml.text(" {1 Stream builders} ") +/*** {1 Stream builders} */ /** [Stream.from f] returns a stream built from the function [f]. To create a new stream element, the function [f] is called with @@ -53,13 +51,13 @@ let of_string: string => t @since 4.02.0 */ let of_bytes: bytes => t -@@ocaml.text(" {1 Stream iterator} ") +/* {1 Stream iterator} */ /** [Stream.iter f s] scans the whole stream s, applying function [f] in turn to each stream element encountered. */ let iter: ('a => unit, t<'a>) => unit -@@ocaml.text(" {1 Predefined parsers} ") +/* {1 Predefined parsers} */ /** Return the first element of the stream and remove it from the stream. Raise {!Stream.Failure} if the stream is empty. */ @@ -68,7 +66,7 @@ let next: t<'a> => 'a /** Return [()] if the stream is empty, else raise {!Stream.Failure}. */ let empty: t<'a> => unit -@@ocaml.text(" {1 Useful functions} ") +/* {1 Useful functions} */ /** Return [Some] of \"the first element\" of the stream, or [None] if the stream is empty. */ @@ -87,8 +85,6 @@ let count: t<'a> => int elements are available. */ let npeek: (int, t<'a>) => list<'a> -@@ocaml.text("/*") - /* The following is for system use only. Do not call directly. */ let iapp: (t<'a>, t<'a>) => t<'a> diff --git a/jscomp/stdlib-406/string.resi b/jscomp/stdlib-406/string.resi index 7ac1bd04a0..7bd1ef6ba9 100644 --- a/jscomp/stdlib-406/string.resi +++ b/jscomp/stdlib-406/string.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,7 +13,7 @@ /* */ /* ************************************************************************ */ -" String operations. +/*** String operations. A string is an immutable data structure that contains a fixed-length sequence of (single-byte) characters. Each character @@ -45,8 +45,7 @@ All new code should avoid this feature and be compiled with the [-safe-string] command-line option to enforce the separation between the types [string] and [bytes]. - - ") +*/ /** Return the length (number of characters) of the given string. */ external length: string => int = "%string_length" @@ -271,8 +270,6 @@ let equal: (t, t) => bool */ let split_on_char: (char, string) => list -@@ocaml.text("/*") - /* The following is for system use only. Do not call directly. */ external unsafe_get: (string, int) => char = "%string_unsafe_get" diff --git a/jscomp/stdlib-406/stringLabels.resi b/jscomp/stdlib-406/stringLabels.resi index a792df1ac5..2886ac2a44 100644 --- a/jscomp/stdlib-406/stringLabels.resi +++ b/jscomp/stdlib-406/stringLabels.resi @@ -1,21 +1,19 @@ -@@ocaml.text( - /* ************************************************************************ */ - /* */ - /* 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. */ - /* */ - /* ************************************************************************ */ - - " String operations. " -) +/* ************************************************************************ */ +/* */ +/* 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. */ +/* */ +/* ************************************************************************ */ + +/*** String operations. */ /** Return the length (number of characters) of the given string. */ external length: string => int = "%string_length" @@ -230,8 +228,6 @@ let equal: (t, t) => bool */ let split_on_char: (~sep: char, string) => list -@@ocaml.text("/*") - /* The following is for system use only. Do not call directly. */ external unsafe_get: (string, int) => char = "%string_unsafe_get" diff --git a/jscomp/stdlib-406/sys.resi b/jscomp/stdlib-406/sys.resi index 419da77aa0..e09cfbc620 100644 --- a/jscomp/stdlib-406/sys.resi +++ b/jscomp/stdlib-406/sys.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,12 +13,12 @@ /* */ /* ************************************************************************ */ -" System interface. +/*** System interface. Every function in this module raises [Sys_error] with an informative message when the underlying system call signal an error. -") +*/ /** The command line arguments given to the process. The first element is the command name used to invoke the program. @@ -157,7 +157,7 @@ external runtime_variant: unit => string = "?runtime_variant" @since 4.03.0 */ external runtime_parameters: unit => string = "?runtime_parameters" -@@ocaml.text(" {1 Signal handling} ") +/* {1 Signal handling} */ /** What to do when receiving a signal: - [Signal_default]: take the default behavior @@ -180,7 +180,7 @@ let signal: (int, signal_behavior) => signal_behavior /** Same as {!Sys.signal} but return value is ignored. */ let set_signal: (int, signal_behavior) => unit -@@ocaml.text(" {2 Signal numbers for the standard POSIX signals.} ") +/* {2 Signal numbers for the standard POSIX signals.} */ /** Abnormal termination */ let sigabrt: int @@ -303,7 +303,7 @@ let enable_runtime_warnings: bool => unit @since 4.03.0 */ let runtime_warnings_enabled: unit => bool -@@ocaml.text(" {1 Optimization} ") +/* {1 Optimization} */ /** For the purposes of optimization, [opaque_identity] behaves like an unknown (and thus possibly side-effecting) function. diff --git a/jscomp/stdlib-406/uchar.resi b/jscomp/stdlib-406/uchar.resi index 7c240215f8..d837b86a19 100644 --- a/jscomp/stdlib-406/uchar.resi +++ b/jscomp/stdlib-406/uchar.resi @@ -1,4 +1,4 @@ -@@ocaml.text(/* ************************************************************************ */ +/* ************************************************************************ */ /* */ /* OCaml */ /* */ @@ -13,9 +13,9 @@ /* */ /* ************************************************************************ */ -" Unicode characters. +/*** Unicode characters. - @since 4.03 ") + @since 4.03 */ /** The type for Unicode characters. @@ -66,9 +66,7 @@ let is_valid: int => bool @raise Invalid_argument if [i] does not satisfy {!is_valid}. */ let of_int: int => t -@@ocaml.text("/*") let unsafe_of_int: int => t -@@ocaml.text("/*") /** [to_int u] is [u] as an integer. */ let to_int: t => int @@ -84,9 +82,7 @@ let of_char: char => t @raise Invalid_argument if [u] does not satisfy {!is_char}. */ let to_char: t => char -@@ocaml.text("/*") let unsafe_to_char: t => char -@@ocaml.text("/*") /** [equal u u'] is [u = u']. */ let equal: (t, t) => bool From eae720a4e1f2509c2b18585465bf1f0b592d8dea Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 8 Aug 2023 19:46:05 +0200 Subject: [PATCH 7/9] Fix unnecessary escape of double quote --- jscomp/stdlib-406/arg.resi | 10 +++++----- jscomp/stdlib-406/array.resi | 10 +++++----- jscomp/stdlib-406/arrayLabels.resi | 10 +++++----- jscomp/stdlib-406/bytes.resi | 14 +++++++------- jscomp/stdlib-406/char.resi | 2 +- jscomp/stdlib-406/filename.resi | 8 ++++---- jscomp/stdlib-406/genlex.resi | 8 ++++---- jscomp/stdlib-406/hashtbl.resi | 2 +- jscomp/stdlib-406/int32.resi | 2 +- jscomp/stdlib-406/int64.resi | 2 +- jscomp/stdlib-406/lazy.resi | 2 +- jscomp/stdlib-406/list.resi | 10 +++++----- jscomp/stdlib-406/listLabels.resi | 10 +++++----- jscomp/stdlib-406/pervasives.resi | 18 +++++++++--------- jscomp/stdlib-406/pervasivesU.resi | 18 +++++++++--------- jscomp/stdlib-406/stream.resi | 2 +- jscomp/stdlib-406/string.resi | 2 +- jscomp/stdlib-406/sys.resi | 18 +++++++++--------- 18 files changed, 74 insertions(+), 74 deletions(-) diff --git a/jscomp/stdlib-406/arg.resi b/jscomp/stdlib-406/arg.resi index 529f5e60b2..e5b69162a1 100644 --- a/jscomp/stdlib-406/arg.resi +++ b/jscomp/stdlib-406/arg.resi @@ -19,9 +19,9 @@ Examples ([cmd] is assumed to be the command name): - [cmd -flag ](a unit option) - [cmd -int 1 ](an int option with argument [1]) -- [cmd -string foobar ](a string option with argument [\"foobar\"]) +- [cmd -string foobar ](a string option with argument ["foobar"]) - [cmd -float 12.34 ](a float option with argument [12.34]) -- [cmd a b c ](three anonymous arguments: [\"a\"], [\"b\"], and [\"c\"]) +- [cmd a b c ](three anonymous arguments: ["a"], ["b"], and ["c"]) - [cmd a b -- c d ](two anonymous arguments and a rest option with two arguments) */ @@ -53,9 +53,9 @@ type rec spec = | /** If the remaining arguments to process are of the form - [[\"-foo\"; \"arg\"] @ rest] where \"foo\" is + [["-foo"; "arg"] @ rest] where "foo" is registered as [Expand f], then the - arguments [f \"arg\" @ rest] are + arguments [f "arg" @ rest] are processed. Only allowed in [parse_and_expand_argv_dynamic]. */ Expand(string => array) @@ -84,7 +84,7 @@ type anon_fun = string => unit list. For the user to be able to specify anonymous arguments starting with a - [-], include for example [(\"-\", String anon_fun, doc)] in [speclist]. + [-], include for example [("-", String anon_fun, doc)] in [speclist]. By default, [parse] recognizes two unit options, [-help] and [--help], which will print to standard output [usage_msg] and the list of diff --git a/jscomp/stdlib-406/array.resi b/jscomp/stdlib-406/array.resi index 3a725b9e7e..d16f7bb088 100644 --- a/jscomp/stdlib-406/array.resi +++ b/jscomp/stdlib-406/array.resi @@ -23,7 +23,7 @@ external length: array<'a> => int = "%array_length" The last element has number [Array.length a - 1]. You can also write [a.(n)] instead of [Array.get a n]. - Raise [Invalid_argument \"index out of bounds\"] + Raise [Invalid_argument "index out of bounds"] if [n] is outside the range 0 to [(Array.length a - 1)]. */ external get: (array<'a>, int) => 'a = "%array_safe_get" @@ -31,7 +31,7 @@ external get: (array<'a>, int) => 'a = "%array_safe_get" element number [n] with [x]. You can also write [a.(n) <- x] instead of [Array.set a n x]. - Raise [Invalid_argument \"index out of bounds\"] + Raise [Invalid_argument "index out of bounds"] if [n] is outside the range 0 to [Array.length a - 1]. */ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" @@ -99,7 +99,7 @@ let concat: list> => array<'a> containing the elements number [start] to [start + len - 1] of array [a]. - Raise [Invalid_argument \"Array.sub\"] if [start] and [len] do not + Raise [Invalid_argument "Array.sub"] if [start] and [len] do not designate a valid subarray of [a]; that is, if [start < 0], or [len < 0], or [start + len > Array.length a]. */ let sub: (array<'a>, int, int) => array<'a> @@ -111,7 +111,7 @@ let copy: array<'a> => array<'a> /** [Array.fill a ofs len x] modifies the array [a] in place, storing [x] in elements number [ofs] to [ofs + len - 1]. - Raise [Invalid_argument \"Array.fill\"] if [ofs] and [len] do not + Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not designate a valid subarray of [a]. */ let fill: (array<'a>, int, int, 'a) => unit @@ -121,7 +121,7 @@ let fill: (array<'a>, int, int, 'a) => unit [v1] and [v2] are the same array, and the source and destination chunks overlap. - Raise [Invalid_argument \"Array.blit\"] if [o1] and [len] do not + Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not designate a valid subarray of [v1], or if [o2] and [len] do not designate a valid subarray of [v2]. */ let blit: (array<'a>, int, array<'a>, int, int) => unit diff --git a/jscomp/stdlib-406/arrayLabels.resi b/jscomp/stdlib-406/arrayLabels.resi index 02733ec3aa..1a211691d3 100644 --- a/jscomp/stdlib-406/arrayLabels.resi +++ b/jscomp/stdlib-406/arrayLabels.resi @@ -23,7 +23,7 @@ external length: array<'a> => int = "%array_length" The last element has number [Array.length a - 1]. You can also write [a.(n)] instead of [Array.get a n]. - Raise [Invalid_argument \"index out of bounds\"] + Raise [Invalid_argument "index out of bounds"] if [n] is outside the range 0 to [(Array.length a - 1)]. */ external get: (array<'a>, int) => 'a = "%array_safe_get" @@ -31,7 +31,7 @@ external get: (array<'a>, int) => 'a = "%array_safe_get" element number [n] with [x]. You can also write [a.(n) <- x] instead of [Array.set a n x]. - Raise [Invalid_argument \"index out of bounds\"] + Raise [Invalid_argument "index out of bounds"] if [n] is outside the range 0 to [Array.length a - 1]. */ external set: (array<'a>, int, 'a) => unit = "%array_safe_set" @@ -91,7 +91,7 @@ let concat: list> => array<'a> containing the elements number [start] to [start + len - 1] of array [a]. - Raise [Invalid_argument \"Array.sub\"] if [start] and [len] do not + Raise [Invalid_argument "Array.sub"] if [start] and [len] do not designate a valid subarray of [a]; that is, if [start < 0], or [len < 0], or [start + len > Array.length a]. */ let sub: (array<'a>, ~pos: int, ~len: int) => array<'a> @@ -103,7 +103,7 @@ let copy: array<'a> => array<'a> /** [Array.fill a ofs len x] modifies the array [a] in place, storing [x] in elements number [ofs] to [ofs + len - 1]. - Raise [Invalid_argument \"Array.fill\"] if [ofs] and [len] do not + Raise [Invalid_argument "Array.fill"] if [ofs] and [len] do not designate a valid subarray of [a]. */ let fill: (array<'a>, ~pos: int, ~len: int, 'a) => unit @@ -113,7 +113,7 @@ let fill: (array<'a>, ~pos: int, ~len: int, 'a) => unit [v1] and [v2] are the same array, and the source and destination chunks overlap. - Raise [Invalid_argument \"Array.blit\"] if [o1] and [len] do not + Raise [Invalid_argument "Array.blit"] if [o1] and [len] do not designate a valid subarray of [v1], or if [o2] and [len] do not designate a valid subarray of [v2]. */ let blit: (~src: array<'a>, ~src_pos: int, ~dst: array<'a>, ~dst_pos: int, ~len: int) => unit diff --git a/jscomp/stdlib-406/bytes.resi b/jscomp/stdlib-406/bytes.resi index d168d923cd..2b65cb4695 100644 --- a/jscomp/stdlib-406/bytes.resi +++ b/jscomp/stdlib-406/bytes.resi @@ -305,8 +305,8 @@ let equal: (t, t) => bool /** Unsafely convert a byte sequence into a string. To reason about the use of [unsafe_to_string], it is convenient to - consider an \"ownership\" discipline. A piece of code that - manipulates some data \"owns\" it; there are several disjoint ownership + consider an "ownership" discipline. A piece of code that + manipulates some data "owns" it; there are several disjoint ownership modes, including: - Unique ownership: the data may be accessed and mutated - Shared ownership: the data has several owners, that may only @@ -394,19 +394,19 @@ let unsafe_to_string: bytes => string compiler, so you never uniquely own them. {[ -let incorrect = Bytes.unsafe_of_string \"hello\" -let s = Bytes.of_string \"hello\" +let incorrect = Bytes.unsafe_of_string "hello" +let s = Bytes.of_string "hello" ]} The first declaration is incorrect, because the string literal - [\"hello\"] could be shared by the compiler with other parts of the + ["hello"] could be shared by the compiler with other parts of the program, and mutating [incorrect] is a bug. You must always use the second version, which performs a copy and is thus correct. Assuming unique ownership of strings that are not string literals, but are (partly) built from string literals, is also - incorrect. For example, mutating [unsafe_of_string (\"foo\" ^ s)] - could mutate the shared string [\"foo\"] -- assuming a rope-like + incorrect. For example, mutating [unsafe_of_string ("foo" ^ s)] + could mutate the shared string ["foo"] -- assuming a rope-like representation of strings. More generally, functions operating on strings will assume shared ownership, they do not preserve unique ownership. It is thus incorrect to assume unique ownership of the diff --git a/jscomp/stdlib-406/char.resi b/jscomp/stdlib-406/char.resi index 58da9b7a5e..78e07aa735 100644 --- a/jscomp/stdlib-406/char.resi +++ b/jscomp/stdlib-406/char.resi @@ -19,7 +19,7 @@ external code: char => int = "%identity" /** Return the character with the given ASCII code. - Raise [Invalid_argument \"Char.chr\"] if the argument is + Raise [Invalid_argument "Char.chr"] if the argument is outside the range 0--255. */ let chr: int => char diff --git a/jscomp/stdlib-406/filename.resi b/jscomp/stdlib-406/filename.resi index cf5037bc17..e9da0f7634 100644 --- a/jscomp/stdlib-406/filename.resi +++ b/jscomp/stdlib-406/filename.resi @@ -97,9 +97,9 @@ let basename: string => string let dirname: string => string /** The name of the temporary directory: - Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" + Under Unix, the value of the [TMPDIR] environment variable, or "/tmp" if the variable is not set. - Under Windows, the value of the [TEMP] environment variable, or \".\" + Under Windows, the value of the [TEMP] environment variable, or "." if the variable is not set. The temporary directory can be changed with {!Filename.set_temp_dir_name}. @since 4.00.0 @@ -114,9 +114,9 @@ let set_temp_dir_name: string => unit @deprecated("Use Filename.get_temp_dir_name instead") /** The name of the initial temporary directory: - Under Unix, the value of the [TMPDIR] environment variable, or \"/tmp\" + Under Unix, the value of the [TMPDIR] environment variable, or "/tmp" if the variable is not set. - Under Windows, the value of the [TEMP] environment variable, or \".\" + Under Windows, the value of the [TEMP] environment variable, or "." if the variable is not set. @deprecated You should use {!Filename.get_temp_dir_name} instead. @since 3.09.1 diff --git a/jscomp/stdlib-406/genlex.resi b/jscomp/stdlib-406/genlex.resi index c91885fadf..48dc4f9927 100644 --- a/jscomp/stdlib-406/genlex.resi +++ b/jscomp/stdlib-406/genlex.resi @@ -23,7 +23,7 @@ Example: a lexer suitable for a desk calculator is obtained by - {[ let lexer = make_lexer [\"+\";\"-\";\"*\";\"/\";\"let\";\"=\"; \"(\"; \")\"] ]} + {[ let lexer = make_lexer ["+";"-";"*";"/";"let";"="; "("; ")"] ]} The associated parser would be a function from [token stream] to, for instance, [int], and would have rules such as: @@ -33,16 +33,16 @@ | [< n1 = parse_atom; n2 = parse_remainder n1 >] -> n2 and parse_atom = parser | [< 'Int n >] -> n - | [< 'Kwd \"(\"; n = parse_expr; 'Kwd \")\" >] -> n + | [< 'Kwd "("; n = parse_expr; 'Kwd ")" >] -> n and parse_remainder n1 = parser - | [< 'Kwd \"+\"; n2 = parse_expr >] -> n1+n2 + | [< 'Kwd "+"; n2 = parse_expr >] -> n1+n2 | [< >] -> n1 ]} One should notice that the use of the [parser] keyword and associated notation for streams are only available through camlp4 extensions. This means that one has to preprocess its sources {i e. g.} by using the - [\"-pp\"] command-line switch of the compilers. + ["-pp"] command-line switch of the compilers. */ /** The type of tokens. The lexical classes are: [Int] and [Float] diff --git a/jscomp/stdlib-406/hashtbl.resi b/jscomp/stdlib-406/hashtbl.resi index 64c33f7066..5acfde280f 100644 --- a/jscomp/stdlib-406/hashtbl.resi +++ b/jscomp/stdlib-406/hashtbl.resi @@ -232,7 +232,7 @@ The functorial interface allows the use of specific comparison module IntHashtbl = Hashtbl.Make(IntHash) let h = IntHashtbl.create 17 in - IntHashtbl.add h 12 \"hello\" + IntHashtbl.add h 12 "hello" ]} This creates a new module [IntHashtbl], with a new type ['a diff --git a/jscomp/stdlib-406/int32.resi b/jscomp/stdlib-406/int32.resi index 4193a77919..174036f240 100644 --- a/jscomp/stdlib-406/int32.resi +++ b/jscomp/stdlib-406/int32.resi @@ -135,7 +135,7 @@ external to_float: t => float = "?int_to_float" The [_] (underscore) character can appear anywhere in the string and is ignored. - Raise [Failure \"Int32.of_string\"] if the given string is not + Raise [Failure "Int32.of_string"] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [t]. */ external of_string: string => t = "?int_of_string" diff --git a/jscomp/stdlib-406/int64.resi b/jscomp/stdlib-406/int64.resi index a0e3629ef4..aeb0588c0f 100644 --- a/jscomp/stdlib-406/int64.resi +++ b/jscomp/stdlib-406/int64.resi @@ -145,7 +145,7 @@ external to_int32: int64 => int = "%int64_to_int32" The [_] (underscore) character can appear anywhere in the string and is ignored. - Raise [Failure \"Int64.of_string\"] if the given string is not + Raise [Failure "Int64.of_string"] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int64]. */ external of_string: string => int64 = "?int64_of_string" diff --git a/jscomp/stdlib-406/lazy.resi b/jscomp/stdlib-406/lazy.resi index 1dcb388285..fee1eefff9 100644 --- a/jscomp/stdlib-406/lazy.resi +++ b/jscomp/stdlib-406/lazy.resi @@ -19,7 +19,7 @@ a suspension, that has a result of type ['a]. The special expression syntax [lazy (expr)] makes a suspension of the computation of [expr], without computing [expr] itself yet. - \"Forcing\" the suspension will then compute [expr] and return its + "Forcing" the suspension will then compute [expr] and return its result. Note: [lazy_t] is the built-in type constructor used by the compiler diff --git a/jscomp/stdlib-406/list.resi b/jscomp/stdlib-406/list.resi index 3c3d04e9ea..27e82bbdf8 100644 --- a/jscomp/stdlib-406/list.resi +++ b/jscomp/stdlib-406/list.resi @@ -49,23 +49,23 @@ let compare_length_with: (list<'a>, int) => int let cons: ('a, list<'a>) => list<'a> /** Return the first element of the given list. Raise - [Failure \"hd\"] if the list is empty. */ + [Failure "hd"] if the list is empty. */ let hd: list<'a> => 'a /** Return the given list without its first element. Raise - [Failure \"tl\"] if the list is empty. */ + [Failure "tl"] if the list is empty. */ let tl: list<'a> => list<'a> /** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. - Raise [Failure \"nth\"] if the list is too short. - Raise [Invalid_argument \"List.nth\"] if [n] is negative. */ + Raise [Failure "nth"] if the list is too short. + Raise [Invalid_argument "List.nth"] if [n] is negative. */ let nth: (list<'a>, int) => 'a /** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. Return [None] if the list is too short. - Raise [Invalid_argument \"List.nth\"] if [n] is negative. + Raise [Invalid_argument "List.nth"] if [n] is negative. @since 4.05 */ let nth_opt: (list<'a>, int) => option<'a> diff --git a/jscomp/stdlib-406/listLabels.resi b/jscomp/stdlib-406/listLabels.resi index 3f9a3faf71..c48e830a47 100644 --- a/jscomp/stdlib-406/listLabels.resi +++ b/jscomp/stdlib-406/listLabels.resi @@ -30,7 +30,7 @@ let length: list<'a> => int /** Return the first element of the given list. Raise - [Failure \"hd\"] if the list is empty. */ + [Failure "hd"] if the list is empty. */ let hd: list<'a> => 'a /** Compare the lengths of two lists. [compare_lengths l1 l2] is @@ -53,19 +53,19 @@ let compare_length_with: (list<'a>, ~len: int) => int let cons: ('a, list<'a>) => list<'a> /** Return the given list without its first element. Raise - [Failure \"tl\"] if the list is empty. */ + [Failure "tl"] if the list is empty. */ let tl: list<'a> => list<'a> /** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. - Raise [Failure \"nth\"] if the list is too short. - Raise [Invalid_argument \"List.nth\"] if [n] is negative. */ + Raise [Failure "nth"] if the list is too short. + Raise [Invalid_argument "List.nth"] if [n] is negative. */ let nth: (list<'a>, int) => 'a /** Return the [n]-th element of the given list. The first element (head of the list) is at position 0. Return [None] if the list is too short. - Raise [Invalid_argument \"List.nth\"] if [n] is negative. + Raise [Invalid_argument "List.nth"] if [n] is negative. @since 4.05 */ let nth_opt: (list<'a>, int) => option<'a> diff --git a/jscomp/stdlib-406/pervasives.resi b/jscomp/stdlib-406/pervasives.resi index 83673a42ed..46b0eb5e68 100644 --- a/jscomp/stdlib-406/pervasives.resi +++ b/jscomp/stdlib-406/pervasives.resi @@ -163,7 +163,7 @@ external \"||": (bool, bool) => bool = "%sequor" /** [__LOC__] returns the location at which this expression appears in the file currently being parsed by the compiler, with the standard - error format of OCaml: \"File %S, line %d, characters %d-%d\". + error format of OCaml: "File %S, line %d, characters %d-%d". @since 4.02.0 */ external __LOC__: string = "%loc_LOC" @@ -197,8 +197,8 @@ external __POS__: (string, int, int, int) = "%loc_POS" /** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the location of [expr] in the file currently being parsed by the - compiler, with the standard error format of OCaml: \"File %S, line - %d, characters %d-%d\". + compiler, with the standard error format of OCaml: "File %S, line + %d, characters %d-%d". @since 4.02.0 */ external __LOC_OF__: 'a => (string, 'a) = "%loc_LOC" @@ -572,7 +572,7 @@ external \"^": (string, string) => string = "#string_append" external int_of_char: char => int = "%identity" /** Return the character with the given ASCII code. - Raise [Invalid_argument \"char_of_int\"] if the argument is + Raise [Invalid_argument "char_of_int"] if the argument is outside the range 0--255. */ let char_of_int: int => char @@ -594,13 +594,13 @@ external ignore: 'a => unit = "%ignore" let string_of_bool: bool => string /** Convert the given string to a boolean. - Raise [Invalid_argument \"bool_of_string\"] if the string is not - [\"true\"] or [\"false\"]. */ + Raise [Invalid_argument "bool_of_string"] if the string is not + ["true"] or ["false"]. */ let bool_of_string: string => bool /** Convert the given string to a boolean. Return [None] if the string is not - [\"true\"] or [\"false\"]. + ["true"] or ["false"]. @since 4.05 */ let bool_of_string_opt: string => option @@ -621,7 +621,7 @@ external string_of_int: int => string = "String" The [_] (underscore) character can appear anywhere in the string and is ignored. - Raise [Failure \"int_of_string\"] if the given string is not + Raise [Failure "int_of_string"] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int]. */ external int_of_string: string => int = "?int_of_string" @@ -648,7 +648,7 @@ let string_of_float: float => string and is ignored. Depending on the execution platforms, other representations of floating-point numbers can be accepted, but should not be relied upon. - Raise [Failure \"float_of_string\"] if the given string is not a valid + Raise [Failure "float_of_string"] if the given string is not a valid representation of a float. */ external float_of_string: string => float = "?float_of_string" diff --git a/jscomp/stdlib-406/pervasivesU.resi b/jscomp/stdlib-406/pervasivesU.resi index e51c68be81..2526d1dee7 100644 --- a/jscomp/stdlib-406/pervasivesU.resi +++ b/jscomp/stdlib-406/pervasivesU.resi @@ -166,7 +166,7 @@ external \"||": (bool, bool) => bool = "%sequor" /** [__LOC__] returns the location at which this expression appears in the file currently being parsed by the compiler, with the standard - error format of OCaml: \"File %S, line %d, characters %d-%d\". + error format of OCaml: "File %S, line %d, characters %d-%d". @since 4.02.0 */ external __LOC__: string = "%loc_LOC" @@ -200,8 +200,8 @@ external __POS__: (string, int, int, int) = "%loc_POS" /** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the location of [expr] in the file currently being parsed by the - compiler, with the standard error format of OCaml: \"File %S, line - %d, characters %d-%d\". + compiler, with the standard error format of OCaml: "File %S, line + %d, characters %d-%d". @since 4.02.0 */ external __LOC_OF__: 'a => (string, 'a) = "%loc_LOC" @@ -575,7 +575,7 @@ external \"^": (string, string) => string = "#string_append" external int_of_char: char => int = "%identity" /** Return the character with the given ASCII code. - Raise [Invalid_argument \"char_of_int\"] if the argument is + Raise [Invalid_argument "char_of_int"] if the argument is outside the range 0--255. */ let char_of_int: int => char @@ -597,13 +597,13 @@ external ignore: 'a => unit = "%ignore" let string_of_bool: bool => string /** Convert the given string to a boolean. - Raise [Invalid_argument \"bool_of_string\"] if the string is not - [\"true\"] or [\"false\"]. */ + Raise [Invalid_argument "bool_of_string"] if the string is not + ["true"] or ["false"]. */ let bool_of_string: string => bool /** Convert the given string to a boolean. Return [None] if the string is not - [\"true\"] or [\"false\"]. + ["true"] or ["false"]. @since 4.05 */ let bool_of_string_opt: string => option @@ -624,7 +624,7 @@ external string_of_int: int => string = "String" The [_] (underscore) character can appear anywhere in the string and is ignored. - Raise [Failure \"int_of_string\"] if the given string is not + Raise [Failure "int_of_string"] if the given string is not a valid representation of an integer, or if the integer represented exceeds the range of integers representable in type [int]. */ external int_of_string: string => int = "?int_of_string" @@ -651,7 +651,7 @@ let string_of_float: float => string and is ignored. Depending on the execution platforms, other representations of floating-point numbers can be accepted, but should not be relied upon. - Raise [Failure \"float_of_string\"] if the given string is not a valid + Raise [Failure "float_of_string"] if the given string is not a valid representation of a float. */ external float_of_string: string => float = "?float_of_string" diff --git a/jscomp/stdlib-406/stream.resi b/jscomp/stdlib-406/stream.resi index e72e2e1dce..952e6b9d4e 100644 --- a/jscomp/stdlib-406/stream.resi +++ b/jscomp/stdlib-406/stream.resi @@ -68,7 +68,7 @@ let empty: t<'a> => unit /* {1 Useful functions} */ -/** Return [Some] of \"the first element\" of the stream, or [None] if +/** Return [Some] of "the first element" of the stream, or [None] if the stream is empty. */ let peek: t<'a> => option<'a> diff --git a/jscomp/stdlib-406/string.resi b/jscomp/stdlib-406/string.resi index 7bd1ef6ba9..319e089ae4 100644 --- a/jscomp/stdlib-406/string.resi +++ b/jscomp/stdlib-406/string.resi @@ -35,7 +35,7 @@ OCaml strings used to be modifiable in place, for instance via the {!String.set} and {!String.blit} functions described below. This usage is deprecated and only possible when the compiler is put in - \"unsafe-string\" mode by giving the [-unsafe-string] command-line + "unsafe-string" mode by giving the [-unsafe-string] command-line option (which is currently the default for reasons of backward compatibility). This is done by making the types [string] and [bytes] (see module {!Bytes}) interchangeable so that functions diff --git a/jscomp/stdlib-406/sys.resi b/jscomp/stdlib-406/sys.resi index e09cfbc620..544b6434ad 100644 --- a/jscomp/stdlib-406/sys.resi +++ b/jscomp/stdlib-406/sys.resi @@ -49,7 +49,7 @@ external remove: string => unit = "?sys_remove" Depending on the operating system, the metadata (permissions, owner, etc) of [newpath] can either be preserved or be replaced by those of [oldpath]. - @since 4.06 concerning the \"replace existing file\" behavior */ + @since 4.06 concerning the "replace existing file" behavior */ external rename: (string, string) => unit = "?sys_rename" /** Return the value associated to a variable in the process @@ -77,7 +77,7 @@ external getcwd: unit => string = "?sys_getcwd" /** Return the names of all files present in the given directory. Names denoting the current directory and the parent directory - ([\".\"] and [\"..\"] in Unix) are not returned. Each string in the + (["."] and [".."] in Unix) are not returned. Each string in the result is a file name rather than a complete path. There is no guarantee that the name strings in the resulting array will appear in any specific order; they are not, in particular, guaranteed to @@ -90,9 +90,9 @@ external readdir: string => array = "?sys_read_directory" let interactive: ref /** Operating system currently executing the OCaml program. One of -- [\"Unix\"] (for all Unix versions, including Linux and Mac OS X), -- [\"Win32\"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw), -- [\"Cygwin\"] (for MS-Windows, OCaml compiled with Cygwin). */ +- ["Unix"] (for all Unix versions, including Linux and Mac OS X), +- ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or Mingw), +- ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). */ let os_type: string /** Currently, the official distribution only supports [Native] and @@ -111,15 +111,15 @@ type backend_type = */ let backend_type: backend_type -/** True if [Sys.os_type = \"Unix\"]. +/** True if [Sys.os_type = "Unix"]. @since 4.01.0 */ let unix: bool -/** True if [Sys.os_type = \"Win32\"]. +/** True if [Sys.os_type = "Win32"]. @since 4.01.0 */ let win32: bool -/** True if [Sys.os_type = \"Cygwin\"]. +/** True if [Sys.os_type = "Cygwin"]. @since 4.01.0 */ let cygwin: bool @@ -284,7 +284,7 @@ let sigxfsz: int let catch_break: bool => unit /** [ocaml_version] is the version of OCaml. - It is a string of the form [\"major.minor[.patchlevel][+additional-info]\"], + It is a string of the form ["major.minor[.patchlevel][+additional-info]"], where [major], [minor], and [patchlevel] are integers, and [additional-info] is an arbitrary string. The [[.patchlevel]] and [[+additional-info]] parts may be absent. */ From 68f4b9341ac64380edfcdddcabd592c358cccba3 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 8 Aug 2023 19:51:48 +0200 Subject: [PATCH 8/9] Update ninja.js --- scripts/ninja.js | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/scripts/ninja.js b/scripts/ninja.js index 4cf4e3b544..f3112ca96e 100755 --- a/scripts/ninja.js +++ b/scripts/ninja.js @@ -1068,10 +1068,7 @@ ${ninjaQuickBuildList([ var sources = stdlibDirFiles.filter(x => { return ( !x.startsWith("pervasives.") && - (x.endsWith(".ml") || - x.endsWith(".mli") || - x.endsWith(".res") || - x.endsWith(".resi")) + (x.endsWith(".res") || x.endsWith(".resi")) ); }); let depsMap = new Map(); From 1e54b13bd077e4b1c2afe110d7eee7c807a316bf Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 8 Aug 2023 20:19:50 +0200 Subject: [PATCH 9/9] Update artifact list --- packages/artifacts.txt | 146 ++++++++++++++++++++--------------------- 1 file changed, 73 insertions(+), 73 deletions(-) diff --git a/packages/artifacts.txt b/packages/artifacts.txt index 4de9465a4b..19639d99a4 100644 --- a/packages/artifacts.txt +++ b/packages/artifacts.txt @@ -347,14 +347,14 @@ lib/ocaml/array.cmi lib/ocaml/array.cmj lib/ocaml/array.cmt lib/ocaml/array.cmti -lib/ocaml/array.ml -lib/ocaml/array.mli +lib/ocaml/array.res +lib/ocaml/array.resi lib/ocaml/arrayLabels.cmi lib/ocaml/arrayLabels.cmj lib/ocaml/arrayLabels.cmt lib/ocaml/arrayLabels.cmti -lib/ocaml/arrayLabels.ml -lib/ocaml/arrayLabels.mli +lib/ocaml/arrayLabels.res +lib/ocaml/arrayLabels.resi lib/ocaml/belt.cmi lib/ocaml/belt.cmj lib/ocaml/belt.cmt @@ -600,56 +600,56 @@ lib/ocaml/buffer.cmi lib/ocaml/buffer.cmj lib/ocaml/buffer.cmt lib/ocaml/buffer.cmti -lib/ocaml/buffer.ml -lib/ocaml/buffer.mli +lib/ocaml/buffer.res +lib/ocaml/buffer.resi lib/ocaml/bytes.cmi lib/ocaml/bytes.cmj lib/ocaml/bytes.cmt lib/ocaml/bytes.cmti -lib/ocaml/bytes.ml -lib/ocaml/bytes.mli +lib/ocaml/bytes.res +lib/ocaml/bytes.resi lib/ocaml/bytesLabels.cmi lib/ocaml/bytesLabels.cmj lib/ocaml/bytesLabels.cmt lib/ocaml/bytesLabels.cmti -lib/ocaml/bytesLabels.ml -lib/ocaml/bytesLabels.mli +lib/ocaml/bytesLabels.res +lib/ocaml/bytesLabels.resi lib/ocaml/callback.cmi lib/ocaml/callback.cmj lib/ocaml/callback.cmt lib/ocaml/callback.cmti -lib/ocaml/callback.ml -lib/ocaml/callback.mli +lib/ocaml/callback.res +lib/ocaml/callback.resi lib/ocaml/camlinternalLazy.cmi lib/ocaml/camlinternalLazy.cmj lib/ocaml/camlinternalLazy.cmt lib/ocaml/camlinternalLazy.cmti -lib/ocaml/camlinternalLazy.ml -lib/ocaml/camlinternalLazy.mli +lib/ocaml/camlinternalLazy.res +lib/ocaml/camlinternalLazy.resi lib/ocaml/camlinternalMod.cmi lib/ocaml/camlinternalMod.cmj lib/ocaml/camlinternalMod.cmt lib/ocaml/camlinternalMod.cmti -lib/ocaml/camlinternalMod.ml -lib/ocaml/camlinternalMod.mli +lib/ocaml/camlinternalMod.res +lib/ocaml/camlinternalMod.resi lib/ocaml/char.cmi lib/ocaml/char.cmj lib/ocaml/char.cmt lib/ocaml/char.cmti -lib/ocaml/char.ml -lib/ocaml/char.mli +lib/ocaml/char.res +lib/ocaml/char.resi lib/ocaml/complex.cmi lib/ocaml/complex.cmj lib/ocaml/complex.cmt lib/ocaml/complex.cmti -lib/ocaml/complex.ml -lib/ocaml/complex.mli +lib/ocaml/complex.res +lib/ocaml/complex.resi lib/ocaml/digest.cmi lib/ocaml/digest.cmj lib/ocaml/digest.cmt lib/ocaml/digest.cmti -lib/ocaml/digest.ml -lib/ocaml/digest.mli +lib/ocaml/digest.res +lib/ocaml/digest.resi lib/ocaml/dom.cmi lib/ocaml/dom.cmj lib/ocaml/dom.cmt @@ -666,36 +666,36 @@ lib/ocaml/filename.cmi lib/ocaml/filename.cmj lib/ocaml/filename.cmt lib/ocaml/filename.cmti -lib/ocaml/filename.ml -lib/ocaml/filename.mli +lib/ocaml/filename.res +lib/ocaml/filename.resi lib/ocaml/genlex.cmi lib/ocaml/genlex.cmj lib/ocaml/genlex.cmt lib/ocaml/genlex.cmti -lib/ocaml/genlex.ml -lib/ocaml/genlex.mli +lib/ocaml/genlex.res +lib/ocaml/genlex.resi lib/ocaml/hashtbl.cmi lib/ocaml/hashtbl.cmj lib/ocaml/hashtbl.cmt lib/ocaml/hashtbl.cmti -lib/ocaml/hashtbl.ml -lib/ocaml/hashtbl.mli +lib/ocaml/hashtbl.res +lib/ocaml/hashtbl.resi lib/ocaml/hashtblLabels.cmi lib/ocaml/hashtblLabels.cmj lib/ocaml/hashtblLabels.cmt -lib/ocaml/hashtblLabels.ml +lib/ocaml/hashtblLabels.res lib/ocaml/int32.cmi lib/ocaml/int32.cmj lib/ocaml/int32.cmt lib/ocaml/int32.cmti -lib/ocaml/int32.ml -lib/ocaml/int32.mli +lib/ocaml/int32.res +lib/ocaml/int32.resi lib/ocaml/int64.cmi lib/ocaml/int64.cmj lib/ocaml/int64.cmt lib/ocaml/int64.cmti -lib/ocaml/int64.ml -lib/ocaml/int64.mli +lib/ocaml/int64.res +lib/ocaml/int64.resi lib/ocaml/js.cmi lib/ocaml/js.cmj lib/ocaml/js.cmt @@ -906,54 +906,54 @@ lib/ocaml/lazy.cmi lib/ocaml/lazy.cmj lib/ocaml/lazy.cmt lib/ocaml/lazy.cmti -lib/ocaml/lazy.ml -lib/ocaml/lazy.mli +lib/ocaml/lazy.res +lib/ocaml/lazy.resi lib/ocaml/lexing.cmi lib/ocaml/lexing.cmj lib/ocaml/lexing.cmt lib/ocaml/lexing.cmti -lib/ocaml/lexing.ml -lib/ocaml/lexing.mli +lib/ocaml/lexing.res +lib/ocaml/lexing.resi lib/ocaml/list.cmi lib/ocaml/list.cmj lib/ocaml/list.cmt lib/ocaml/list.cmti -lib/ocaml/list.ml -lib/ocaml/list.mli +lib/ocaml/list.res +lib/ocaml/list.resi lib/ocaml/listLabels.cmi lib/ocaml/listLabels.cmj lib/ocaml/listLabels.cmt lib/ocaml/listLabels.cmti -lib/ocaml/listLabels.ml -lib/ocaml/listLabels.mli +lib/ocaml/listLabels.res +lib/ocaml/listLabels.resi lib/ocaml/map.cmi lib/ocaml/map.cmj lib/ocaml/map.cmt lib/ocaml/map.cmti -lib/ocaml/map.ml -lib/ocaml/map.mli +lib/ocaml/map.res +lib/ocaml/map.resi lib/ocaml/mapLabels.cmi lib/ocaml/mapLabels.cmj lib/ocaml/mapLabels.cmt -lib/ocaml/mapLabels.ml +lib/ocaml/mapLabels.res lib/ocaml/moreLabels.cmi lib/ocaml/moreLabels.cmj lib/ocaml/moreLabels.cmt lib/ocaml/moreLabels.cmti -lib/ocaml/moreLabels.ml -lib/ocaml/moreLabels.mli +lib/ocaml/moreLabels.res +lib/ocaml/moreLabels.resi lib/ocaml/obj.cmi lib/ocaml/obj.cmj lib/ocaml/obj.cmt lib/ocaml/obj.cmti -lib/ocaml/obj.ml -lib/ocaml/obj.mli +lib/ocaml/obj.res +lib/ocaml/obj.resi lib/ocaml/parsing.cmi lib/ocaml/parsing.cmj lib/ocaml/parsing.cmt lib/ocaml/parsing.cmti -lib/ocaml/parsing.ml -lib/ocaml/parsing.mli +lib/ocaml/parsing.res +lib/ocaml/parsing.resi lib/ocaml/pervasives.cmi lib/ocaml/pervasives.cmj lib/ocaml/pervasives.cmt @@ -970,72 +970,72 @@ lib/ocaml/queue.cmi lib/ocaml/queue.cmj lib/ocaml/queue.cmt lib/ocaml/queue.cmti -lib/ocaml/queue.ml -lib/ocaml/queue.mli +lib/ocaml/queue.res +lib/ocaml/queue.resi lib/ocaml/random.cmi lib/ocaml/random.cmj lib/ocaml/random.cmt lib/ocaml/random.cmti -lib/ocaml/random.ml -lib/ocaml/random.mli +lib/ocaml/random.res +lib/ocaml/random.resi lib/ocaml/set.cmi lib/ocaml/set.cmj lib/ocaml/set.cmt lib/ocaml/set.cmti -lib/ocaml/set.ml -lib/ocaml/set.mli +lib/ocaml/set.res +lib/ocaml/set.resi lib/ocaml/setLabels.cmi lib/ocaml/setLabels.cmj lib/ocaml/setLabels.cmt -lib/ocaml/setLabels.ml +lib/ocaml/setLabels.res lib/ocaml/sort.cmi lib/ocaml/sort.cmj lib/ocaml/sort.cmt lib/ocaml/sort.cmti -lib/ocaml/sort.ml -lib/ocaml/sort.mli +lib/ocaml/sort.res +lib/ocaml/sort.resi lib/ocaml/stack.cmi lib/ocaml/stack.cmj lib/ocaml/stack.cmt lib/ocaml/stack.cmti -lib/ocaml/stack.ml -lib/ocaml/stack.mli +lib/ocaml/stack.res +lib/ocaml/stack.resi lib/ocaml/stdLabels.cmi lib/ocaml/stdLabels.cmj lib/ocaml/stdLabels.cmt lib/ocaml/stdLabels.cmti -lib/ocaml/stdLabels.ml -lib/ocaml/stdLabels.mli +lib/ocaml/stdLabels.res +lib/ocaml/stdLabels.resi lib/ocaml/stream.cmi lib/ocaml/stream.cmj lib/ocaml/stream.cmt lib/ocaml/stream.cmti -lib/ocaml/stream.ml -lib/ocaml/stream.mli +lib/ocaml/stream.res +lib/ocaml/stream.resi lib/ocaml/string.cmi lib/ocaml/string.cmj lib/ocaml/string.cmt lib/ocaml/string.cmti -lib/ocaml/string.ml -lib/ocaml/string.mli +lib/ocaml/string.res +lib/ocaml/string.resi lib/ocaml/stringLabels.cmi lib/ocaml/stringLabels.cmj lib/ocaml/stringLabels.cmt lib/ocaml/stringLabels.cmti -lib/ocaml/stringLabels.ml -lib/ocaml/stringLabels.mli +lib/ocaml/stringLabels.res +lib/ocaml/stringLabels.resi lib/ocaml/sys.cmi lib/ocaml/sys.cmj lib/ocaml/sys.cmt lib/ocaml/sys.cmti -lib/ocaml/sys.ml -lib/ocaml/sys.mli +lib/ocaml/sys.res +lib/ocaml/sys.resi lib/ocaml/uchar.cmi lib/ocaml/uchar.cmj lib/ocaml/uchar.cmt lib/ocaml/uchar.cmti -lib/ocaml/uchar.ml -lib/ocaml/uchar.mli +lib/ocaml/uchar.res +lib/ocaml/uchar.resi linux/bsb_helper.exe linux/bsc.exe linux/ninja.exe