OCaml 5.3 Stdlib (#1182)

* OCaml 5.3 Stdlib

* conditionalize the changes in ocaml/ocaml#13193

* back to 5.3

* update to the latest upstream changes

* add changelog entry

Changes.md

@@ -21,6 +21,8 @@ Unreleased
   ([#884](https://github.com/melange-re/melange/pull/884)). Use `[@mel.as
   "string here"]` instead.
 - Support OCaml 5.3 ([#1168](https://github.com/melange-re/melange/pull/1168))
+- Upgrade Stdlib to the OCaml 5.3 Stdlib
+  ([#1182](https://github.com/melange-re/melange/pull/1182))
 
 4.0.1 2024-06-07
 ---------------

jscomp/core/lam_analysis.ml

@@ -52,9 +52,10 @@ let rec no_side_effects (lam : Lam.t) : bool =
               (* non-observable side effect *)
               | "caml_sys_get_config" | "caml_sys_argv" (* should be fine *)
               | "caml_sys_executable_name" | "caml_string_repeat"
-              | "caml_make_vect" | "caml_create_bytes" | "caml_obj_dup"
-              | "caml_array_dup" | "nativeint_add" | "nativeint_div"
-              | "nativeint_mod" | "nativeint_lsr" | "nativeint_mul" ),
+              | "caml_make_vect" | "caml_array_make" | "caml_create_bytes"
+              | "caml_obj_dup" | "caml_array_dup" | "nativeint_add"
+              | "nativeint_div" | "nativeint_mod" | "nativeint_lsr"
+              | "nativeint_mul" ),
               _ ) ->
               true
           | "caml_ml_open_descriptor_in", [ Lconst (Const_int { i = 0l; _ }) ]

jscomp/core/lam_dispatch_primitive.ml

@@ -253,7 +253,7 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression
   | "caml_lex_engine" | "caml_new_lex_engine" -> call Js_runtime_modules.lexer
   | "caml_parse_engine" | "caml_set_parser_trace" ->
       call Js_runtime_modules.parser
-  | "caml_make_float_vect"
+  | "caml_make_float_vect" | "caml_array_create_float"
   | "caml_floatarray_create" (* TODO: compile float array into TypedArray*) ->
       E.runtime_call ~module_name:Js_runtime_modules.array ~fn_name:"make_float"
         args
@@ -266,7 +266,7 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression
      Not good for inline *)
   | "caml_array_blit" ->
       E.runtime_call ~module_name:Js_runtime_modules.array ~fn_name:"blit" args
-  | "caml_make_vect" ->
+  | "caml_make_vect" | "caml_array_make" ->
       E.runtime_call ~module_name:Js_runtime_modules.array ~fn_name:"make" args
   | "caml_ml_flush" | "caml_ml_out_channels_list" | "caml_ml_output_char"
   | "caml_ml_output" ->
@@ -329,7 +329,7 @@ let translate loc (prim_name : string) (args : J.expression list) : J.expression
       match args with
       | [ num; behavior ] -> E.seq num behavior (*TODO:*)
       | _ -> assert false)
-  | "caml_md5_string" -> call Js_runtime_modules.md5
+  | "caml_md5_string" | "caml_md5_bytes" -> call Js_runtime_modules.md5
   | "caml_hash_mix_string" | "caml_hash_mix_int" | "caml_hash_final_mix" ->
       call Js_runtime_modules.hash_primitive
   | "caml_hash" -> call Js_runtime_modules.hash

jscomp/runtime/caml_md5.ml

@@ -255,3 +255,6 @@ let caml_md5_string (s : string) start len =
       state.(3) >>~ 16 &~ 0xffl;
       state.(3) >>~ 24 &~ 0xffl;
     |]
+
+let caml_md5_bytes (s : bytes) start len =
+  caml_md5_string (Caml_bytes.bytes_to_string s) start len

jscomp/runtime/caml_md5.mli

@@ -1,5 +1,5 @@
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
- * 
+ *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU Lesser General Public License as published by
  * the Free Software Foundation, either version 3 of the License, or
@@ -17,11 +17,12 @@
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 (** *)
 
 val caml_md5_string : string -> int -> int -> string
+val caml_md5_bytes : bytes -> int -> int -> string

jscomp/stdlib/array.cppo.ml

@@ -23,8 +23,8 @@ 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 = "caml_make_vect"
-external create: int -> 'a -> 'a array = "caml_make_vect"
+external make: int -> 'a -> 'a array = "caml_array_make"
+external create: int -> 'a -> 'a array = "caml_array_make"
 external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
 #ifdef BS
 external append_prim : 'a array -> 'a array -> 'a array = "concat"
@@ -37,7 +37,7 @@ external unsafe_blit :
   'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
 (* external unsafe_fill : *)
   (* 'a array -> int -> int -> 'a -> unit = "caml_array_fill" *)
-external create_float: int -> float array = "caml_make_float_vect"
+external create_float: int -> float array = "caml_array_create_float"
 
 module Floatarray = struct
   external create : int -> floatarray = "caml_floatarray_create"
@@ -106,7 +106,11 @@ let sub a ofs len =
 let fill a ofs len v =
   if ofs < 0 || len < 0 || ofs > length a - len
   then invalid_arg "Array.fill"
+#ifdef BS
   else for i = ofs to ofs + len - 1 do unsafe_set a i v done
+#else
+  else unsafe_fill a ofs len v
+#endif
 
 let blit a1 ofs1 a2 ofs2 len =
   if len < 0 || ofs1 < 0 || ofs1 > length a1 - len
@@ -444,11 +448,21 @@ let stable_sort cmp a =
 
 let fast_sort = stable_sort
 
+let shuffle_contract_violation i j =
+  let int = string_of_int in
+  String.concat "" [
+    "Array.shuffle: 'rand "; int (i + 1);
+    "' returned "; int j;
+    ", out of expected range [0; "; int i; "]"
+  ]
+  |> invalid_arg
+
 let shuffle ~rand a = (* Fisher-Yates *)
   for i = length a - 1 downto 1 do
     let j = rand (i + 1) in
+    if not (0 <= j && j <= i) then shuffle_contract_violation i j;
     let v = unsafe_get a i in
-    unsafe_set a i (get a j);
+    unsafe_set a i (unsafe_get a j);
     unsafe_set a j v
   done
 

jscomp/stdlib/array.mli

@@ -50,7 +50,7 @@ external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
    @raise Invalid_argument
    if [n] is outside the range 0 to [length a - 1]. *)
 
-external make : int -> 'a -> 'a array = "caml_make_vect"
+external make : int -> 'a -> 'a array = "caml_array_make"
 (** [make n x] returns a fresh array of length [n],
    initialized with [x].
    All the elements of this new array are initially
@@ -63,7 +63,7 @@ external make : int -> 'a -> 'a array = "caml_make_vect"
    If the value of [x] is a floating-point number, then the maximum
    size is only [Sys.max_array_length / 2].*)
 
-external create_float: int -> float array = "caml_make_float_vect"
+external create_float: int -> float array = "caml_array_create_float"
 (** [create_float n] returns a fresh float array of length [n],
     with uninitialized data.
     @since 4.03 *)
@@ -98,10 +98,12 @@ val init_matrix : int -> int -> (int -> int -> 'a) -> 'a array array
    where the element at index ([x,y]) is initialized with [f x y].
    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 return type of [f] is [float],
    then the maximum size is only [Sys.max_array_length / 2].
+
    @since 5.2 *)
 
 val append : 'a array -> 'a array -> 'a array
@@ -324,7 +326,7 @@ val sort : ('a -> 'a -> int) -> 'a array -> unit
 
    When [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
+-   [cmp a.(i) a.(j)] >= 0 if i >= j
 *)
 
 val stable_sort : ('a -> 'a -> int) -> 'a array -> unit
@@ -345,10 +347,12 @@ val shuffle :
   rand: (* thwart tools/sync_stdlib_docs *) (int -> int) -> 'a array -> unit
 (** [shuffle rand a] randomly permutes [a]'s element using [rand] for
     randomness. The distribution of permutations is uniform.
+
     [rand] must be such that a call to [rand n] returns a uniformly
     distributed random number in the range \[[0];[n-1]\].
     {!Random.int} can be used for this (do not forget to
     {{!Random.self_init}initialize} the generator).
+
     @since 5.2 *)
 
 (** {1 Arrays and Sequences} *)

jscomp/stdlib/arrayLabels.mli

@@ -50,7 +50,7 @@ external set : 'a array -> int -> 'a -> unit = "%array_safe_set"
    @raise Invalid_argument
    if [n] is outside the range 0 to [length a - 1]. *)
 
-external make : int -> 'a -> 'a array = "caml_make_vect"
+external make : int -> 'a -> 'a array = "caml_array_make"
 (** [make n x] returns a fresh array of length [n],
    initialized with [x].
    All the elements of this new array are initially
@@ -63,7 +63,7 @@ external make : int -> 'a -> 'a array = "caml_make_vect"
    If the value of [x] is a floating-point number, then the maximum
    size is only [Sys.max_array_length / 2].*)
 
-external create_float: int -> float array = "caml_make_float_vect"
+external create_float: int -> float array = "caml_array_create_float"
 (** [create_float n] returns a fresh float array of length [n],
     with uninitialized data.
     @since 4.03 *)
@@ -98,10 +98,12 @@ val init_matrix : dimx:int -> dimy:int -> f:(int -> int -> 'a) -> 'a array array
    where the element at index ([x,y]) is initialized with [f x y].
    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 return type of [f] is [float],
    then the maximum size is only [Sys.max_array_length / 2].
+
    @since 5.2 *)
 
 val append : 'a array -> 'a array -> 'a array
@@ -324,7 +326,7 @@ val sort : cmp:('a -> 'a -> int) -> 'a array -> unit
 
    When [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
+-   [cmp a.(i) a.(j)] >= 0 if i >= j
 *)
 
 val stable_sort : cmp:('a -> 'a -> int) -> 'a array -> unit
@@ -345,10 +347,12 @@ val shuffle :
   rand: (* thwart tools/sync_stdlib_docs *) (int -> int) -> 'a array -> unit
 (** [shuffle ~rand a] randomly permutes [a]'s element using [rand] for
     randomness. The distribution of permutations is uniform.
+
     [rand] must be such that a call to [rand n] returns a uniformly
     distributed random number in the range \[[0];[n-1]\].
     {!Random.int} can be used for this (do not forget to
     {{!Random.self_init}initialize} the generator).
+
     @since 5.2 *)
 
 (** {1 Arrays and Sequences} *)

jscomp/stdlib/atomic.mli

@@ -31,6 +31,7 @@ val make : 'a -> 'a t
 
 (** Create an atomic reference that is alone on a cache line. It occupies 4-16x
     the memory of one allocated with [make v].
+
     The primary purpose is to prevent false-sharing and the resulting
     performance degradation. When a CPU performs an atomic operation, it
     temporarily takes ownership of an entire cache line that contains the

jscomp/stdlib/buffer.ml

@@ -148,7 +148,7 @@ let rec add_utf_16le_uchar b u =
 
 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";
+  then invalid_arg "Buffer.add_substring";
   let position = b.position in
   let {buffer;length} = b.inner in
   let new_position = position + len in
@@ -159,22 +159,24 @@ let add_substring b s offset len =
     Bytes.unsafe_blit_string s offset buffer 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 add_subbytes b bytes offset len =
+  if offset < 0 || len < 0 || offset > Bytes.length bytes - len
+  then invalid_arg "Buffer.add_subbytes";
   let position = b.position in
-  let {buffer; length} = b.inner in
+  let {buffer;length} = b.inner in
   let new_position = position + len in
   if new_position > length then (
     resize b len;
-    Bytes.blit_string s 0 b.inner.buffer b.position len;
+    Bytes.blit bytes offset b.inner.buffer b.position len
   ) else
-    Bytes.unsafe_blit_string s 0 buffer position len;
+    Bytes.unsafe_blit bytes offset buffer position len;
   b.position <- new_position
 
-let add_bytes b s = add_string b (Bytes.unsafe_to_string s)
+let add_string b s =
+  add_substring b s 0 (String.length s)
+
+let add_bytes b bytes =
+  add_subbytes b bytes 0 (Bytes.length bytes)
 
 let add_buffer b bs =
   add_subbytes b bs.inner.buffer 0 bs.position

jscomp/stdlib/bytes.ml

@@ -557,7 +557,7 @@ let dec_invalid = Uchar.utf_decode_invalid
 let[@inline] dec_ret n u = Uchar.utf_decode n (Uchar.unsafe_of_int u)
 
 (* In case of decoding error, if we error on the first byte, we
-   consume the byte, otherwise we consume the [n] bytes preceeding
+   consume the byte, otherwise we consume the [n] bytes preceding
    the erroring byte.
 
    This means that if a client uses decodes without caring about

jscomp/stdlib/camlinternalMod.cppo.ml

@@ -71,9 +71,17 @@ let rec update_mod_field modu i shape n =
   | Value _ ->
      () (* the value is already there *)
   | Class ->
+#if OCAML_VERSION >= (5, 3, 0)
+     assert (Obj.tag n = 0 && Obj.size n = 3);
+#else
      assert (Obj.tag n = 0 && Obj.size n = 4);
+#endif
      let cl = Obj.field modu i in
+#if OCAML_VERSION >= (5, 3, 0)
+     for j = 0 to 2 do
+#else
      for j = 0 to 3 do
+#endif
        Obj.set_field cl j (Obj.field n j)
      done
   | Module comps ->