Initial support for OCaml 5.6

compiler/lib/magic_number.ml

@@ -68,7 +68,7 @@ let () =
   let current = Ocaml_version.current in
   if Ocaml_version.compare current [ 4; 13 ] < 0
   then failwith "OCaml version unsupported. Upgrade to OCaml 4.13 or newer."
-  else if Ocaml_version.compare current [ 5; 6 ] >= 0
+  else if Ocaml_version.compare current [ 5; 7 ] >= 0
   then failwith "OCaml version unsupported. Upgrade js_of_ocaml."
 
 let v = snd (of_string Ocaml_common.Config.exec_magic_number)

compiler/lib/parse_bytecode.ml

@@ -2529,11 +2529,13 @@ and compile infos pc state (instrs : instr list) =
             Var.print
             arg;
         let state, tail =
-          match Ocaml_version.compare Ocaml_version.current [ 5; 2 ] < 0 with
-          | true -> State.pop 2 state, Pc (Int (Targetint.of_int_exn 0))
-          | false ->
-              let tail = State.peek 2 state in
-              State.pop 3 state, Pv tail
+          if
+            Ocaml_version.compare Ocaml_version.current [ 5; 2 ] < 0
+            || Ocaml_version.compare Ocaml_version.current [ 5; 6 ] >= 0
+          then State.pop 2 state, Pc (Int (Targetint.of_int_exn 0))
+          else
+            let tail = State.peek 2 state in
+            State.pop 3 state, Pv tail
         in
         compile
           infos
@@ -2546,11 +2548,13 @@ and compile infos pc state (instrs : instr list) =
         let arg = State.peek 1 state in
         let x, state = State.fresh_var state in
         let tail =
-          match Ocaml_version.compare Ocaml_version.current [ 5; 2 ] < 0 with
-          | true -> Pc (Int (Targetint.of_int_exn 0))
-          | false ->
-              let tail = State.peek 2 state in
-              Pv tail
+          if
+            Ocaml_version.compare Ocaml_version.current [ 5; 2 ] < 0
+            || Ocaml_version.compare Ocaml_version.current [ 5; 6 ] >= 0
+          then Pc (Int (Targetint.of_int_exn 0))
+          else
+            let tail = State.peek 2 state in
+            Pv tail
         in
         if debug_parser ()
         then
@@ -2579,13 +2583,18 @@ and compile infos pc state (instrs : instr list) =
     | REPERFORMTERM ->
         let eff = State.accu state in
         let stack = State.peek 0 state in
-        let tail = State.peek 1 state in
-        let state = State.pop 2 state in
+        let tail, state =
+          if Ocaml_version.compare Ocaml_version.current [ 5; 6 ] >= 0
+          then Pc (Int (Targetint.of_int_exn 0)), State.pop 1 state
+          else
+            let tail = State.peek 1 state in
+            Pv tail, State.pop 2 state
+        in
         let x, state = State.fresh_var state in
 
         if debug_parser ()
         then Format.printf "return reperform(%a, %a)@." Var.print eff Var.print stack;
-        ( Let (x, Prim (Extern "%reperform", [ Pv eff; Pv stack; Pv tail ])) :: instrs
+        ( Let (x, Prim (Extern "%reperform", [ Pv eff; Pv stack; tail ])) :: instrs
         , Return x
         , state )
     | EVENT | BREAK | FIRST_UNIMPLEMENTED_OP -> assert false)

compiler/tests-jsoo/calc_lexer.mll

@@ -14,3 +14,4 @@ rule token = parse
   | '('               { LPAREN }
   | ')'               { RPAREN }
   | eof               { raise Eof }
+  | _ as c            { failwith (Printf.sprintf "unexpected character %C" c) }

compiler/tests-jsoo/lib-gc/test_gc.ml

@@ -36,5 +36,5 @@ type control =
 
 let () =
   assert ((Gc.get ()).custom_minor_max_size = 0);
-  assert ((Gc.stat ()).forced_major_collections = 0);
+  assert (((Gc.stat [@alert "-deprecated"]) ()).forced_major_collections = 0);
   assert ((Gc.quick_stat ()).forced_major_collections = 0)

compiler/tests-jsoo/test_gc.ml

@@ -31,7 +31,7 @@ let ok () = print_endline "OK"
 let ko size = Printf.printf "size=%d, ocaml_version=%s" size Sys.ocaml_version
 
 let%expect_test "stat" =
-  let s = Gc.stat () in
+  let s = (Gc.stat [@alert "-deprecated"]) () in
   let size = Obj.size (Obj.repr s) in
   (match size with
   | 18 when ocaml_version >= (5, 5) -> ok ()

compiler/tests-ocaml/lib-hashtbl/dune

@@ -20,6 +20,6 @@
  (deps ../../../LICENSE)
  (modules htbl)
  (build_if
-  (>= %{ocaml_version} 5))
+  (>= %{ocaml_version} 5.5))
  (libraries)
  (modes js wasm))

compiler/tests-ocaml/lib-hashtbl/htbl.ml

@@ -130,10 +130,12 @@ module HofM (M: Map.S) : Hashtbl.SeededS with type key = M.key =
     let copy = Hashtbl.copy
     let add = Hashtbl.add
     let remove = Hashtbl.remove
+    let find_and_remove = Hashtbl.find_and_remove
     let find = Hashtbl.find
     let find_opt = Hashtbl.find_opt
     let find_all = Hashtbl.find_all
     let replace = Hashtbl.replace
+    let find_and_replace = Hashtbl.find_and_replace
     let mem = Hashtbl.mem
     let iter = Hashtbl.iter
     let fold = Hashtbl.fold
@@ -272,3 +274,19 @@ let () =
   let l = List.sort compare l in
   List.iter (fun (k, v) -> Printf.printf "%i,%i\n" k v) l;
   Printf.printf "%i elements\n" (Hashtbl.length h)
+
+let () =
+  let h = Hashtbl.create 16 in
+  Hashtbl.add h 0 0;
+  assert (Hashtbl.find_and_replace h 0 1 = Some 0);
+  assert (Hashtbl.find_and_remove h 0 = Some 1);
+  assert (Hashtbl.find_and_remove h 0 = None);
+  assert (Hashtbl.find_and_replace h 0 1 = None);
+  assert (Hashtbl.find_and_remove h 0 = Some 1);
+  Hashtbl.clear h;
+  Hashtbl.add h 0 0;
+  Hashtbl.add h 0 1;
+  assert (Hashtbl.find_and_replace h 0 2 = Some 1);
+  assert (Hashtbl.find_and_remove h 0 = Some 2);
+  assert (Hashtbl.find_and_remove h 0 = Some 0);
+  assert (Hashtbl.find_and_remove h 0 = None);

dune-project

@@ -19,7 +19,7 @@
  (description
   "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js")
  (depends
-  (ocaml (and (>= 4.13) (< 5.6)))
+  (ocaml (and (>= 4.13) (< 5.7)))
   (num :with-test)
   (ppx_expect (and (>= v0.16.1) :with-test))
   (ppxlib (>= 0.33))

js_of_ocaml-compiler.opam

@@ -13,7 +13,7 @@ doc: "https://ocsigen.org/js_of_ocaml/latest/manual/overview"
 bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues"
 depends: [
   "dune" {>= "3.20"}
-  "ocaml" {>= "4.13" & < "5.6"}
+  "ocaml" {>= "4.13" & < "5.7"}
   "num" {with-test}
   "ppx_expect" {>= "v0.16.1" & with-test}
   "ppxlib" {>= "0.33"}

lib/gen_stubs/dune

@@ -1,3 +1,5 @@
 (executable
  (name gen_stubs)
- (libraries compiler-libs.common))
+ (libraries compiler-libs.common)
+ (preprocess
+  (pps ppx_optcomp_light)))

lib/gen_stubs/gen_stubs.ml

@@ -28,6 +28,29 @@ void %s () {
     s
     s
 
+let collect_prims externals _mapper desc =
+  let l = List.filter (fun x -> x.[0] <> '%') desc.Parsetree.pval_prim in
+  externals := List.fold_right String_set.add l !externals;
+  desc
+[@@if ocaml_version < (5, 6, 0)]
+
+let collect_prims externals _mapper desc =
+  (match desc.Parsetree.pprim_kind with
+  | Pprim_decl (_, l) ->
+      let l = List.filter (fun x -> x.[0] <> '%') l in
+      externals := List.fold_right String_set.add l !externals
+  | Pprim_alias _ -> ());
+  desc
+[@@if ocaml_version >= (5, 6, 0)]
+
+let make_mapper externals =
+  { Ast_mapper.default_mapper with value_description = collect_prims externals }
+[@@if ocaml_version < (5, 6, 0)]
+
+let make_mapper externals =
+  { Ast_mapper.default_mapper with primitive_description = collect_prims externals }
+[@@if ocaml_version >= (5, 6, 0)]
+
 let () =
   let mls = ref [] in
   let except_mls = ref [] in
@@ -39,12 +62,7 @@ let () =
   let get_externals l =
     let l = List.filter real_ml l in
     let externals = ref String_set.empty in
-    let value_description _mapper desc =
-      let l = List.filter (fun x -> x.[0] <> '%') desc.Parsetree.pval_prim in
-      externals := List.fold_right String_set.add l !externals;
-      desc
-    in
-    let mapper = { Ast_mapper.default_mapper with value_description } in
+    let mapper = make_mapper externals in
     List.iter
       (fun ml ->
         let in_ = open_in ml in

runtime/js/effect.js

@@ -139,6 +139,7 @@ function caml_make_unhandled_effect_exn(eff) {
 //Requires: caml_get_cps_fun
 //If: effects
 //Version: >= 5.0
+//Version: < 5.6
 function caml_perform_effect(eff, k0) {
   if (caml_current_stack.e === 0) {
     var exn = caml_make_unhandled_effect_exn(eff);
@@ -157,13 +158,38 @@ function caml_perform_effect(eff, k0) {
     : caml_trampoline_return(handler, [eff, cont, last_fiber, k1]);
 }
 
+//Provides: caml_perform_effect
+//Requires: caml_pop_fiber, caml_stack_check_depth, caml_trampoline_return
+//Requires: caml_make_unhandled_effect_exn, caml_current_stack
+//Requires: caml_get_cps_fun
+//If: effects
+//Version: >= 5.6
+function caml_perform_effect(eff, k0) {
+  if (caml_current_stack.e === 0) {
+    var exn = caml_make_unhandled_effect_exn(eff);
+    throw exn;
+  }
+  // Get current effect handler
+  var handler = caml_current_stack.h[3];
+  var last_fiber = caml_current_stack;
+  last_fiber.k = k0;
+  var cont = [245 /*continuation*/, last_fiber, last_fiber];
+  // Move to parent fiber and execute the effect handler there
+  // The handler is defined in Stdlib.Effect, so we know that the arity matches
+  var k1 = caml_pop_fiber();
+  return caml_stack_check_depth()
+    ? caml_get_cps_fun(handler)(eff, cont, k1)
+    : caml_trampoline_return(handler, [eff, cont, k1]);
+}
+
 //Provides: caml_reperform_effect
 //Requires: caml_pop_fiber, caml_stack_check_depth, caml_trampoline_return
 //Requires: caml_make_unhandled_effect_exn, caml_current_stack
 //Requires: caml_resume_stack, caml_continuation_use_noexc
 //Requires: caml_get_cps_fun
 //If: effects
 //Version: >= 5.0
+//Version: < 5.6
 function caml_reperform_effect(eff, cont, last, k0) {
   if (caml_current_stack.e === 0) {
     var exn = caml_make_unhandled_effect_exn(eff);
@@ -185,6 +211,36 @@ function caml_reperform_effect(eff, cont, last, k0) {
     : caml_trampoline_return(handler, [eff, cont, last_fiber, k1]);
 }
 
+//Provides: caml_reperform_effect
+//Requires: caml_pop_fiber, caml_stack_check_depth, caml_trampoline_return
+//Requires: caml_make_unhandled_effect_exn, caml_current_stack
+//Requires: caml_resume_stack, caml_continuation_use_noexc
+//Requires: caml_get_cps_fun
+//If: effects
+//Version: >= 5.6
+function caml_reperform_effect(eff, cont, _last, k0) {
+  if (caml_current_stack.e === 0) {
+    var exn = caml_make_unhandled_effect_exn(eff);
+    var stack = caml_continuation_use_noexc(cont);
+    caml_resume_stack(stack, cont[2], k0);
+    throw exn;
+  }
+  // Get current effect handler
+  var handler = caml_current_stack.h[3];
+  var last_fiber = caml_current_stack;
+  last_fiber.k = k0;
+  // [cont_last_fiber] is gone in OCaml 5.6, but we still maintain the tail
+  // at cont[2] ourselves on every (re)perform.
+  cont[2].e = last_fiber;
+  cont[2] = last_fiber;
+  // Move to parent fiber and execute the effect handler there
+  // The handler is defined in Stdlib.Effect, so we know that the arity matches
+  var k1 = caml_pop_fiber();
+  return caml_stack_check_depth()
+    ? caml_get_cps_fun(handler)(eff, cont, k1)
+    : caml_trampoline_return(handler, [eff, cont, k1]);
+}
+
 //Provides: caml_get_cps_fun
 //If: effects
 //If: !doubletranslate

runtime/js/gc.js

@@ -196,3 +196,22 @@ function caml_gc_tweak_list_active(_unit) {
 function caml_gc_tweak_list_active(_unit) {
   return 0;
 }
+
+//Provides: caml_runtime_hashtbl_randomized
+//Version: >= 5.6
+var caml_runtime_hashtbl_randomized = 0;
+
+//Provides: caml_runtime_hashtbl_randomize
+//Requires: caml_runtime_hashtbl_randomized
+//Version: >= 5.6
+function caml_runtime_hashtbl_randomize(_unit) {
+  caml_runtime_hashtbl_randomized = 1;
+  return 0;
+}
+
+//Provides: caml_runtime_hashtbl_is_randomized
+//Requires: caml_runtime_hashtbl_randomized
+//Version: >= 5.6
+function caml_runtime_hashtbl_is_randomized(_unit) {
+  return caml_runtime_hashtbl_randomized;
+}

runtime/wasm/array.wat

@@ -29,7 +29,9 @@
    (global $empty_array (ref eq)
       (array.new_fixed $block 1 (ref.i31 (i32.const 0))))
 
-   (func $caml_make_vect (export "caml_make_vect") (export "caml_array_make")
+   (func $caml_make_vect
+      (export "caml_make_vect") (export "caml_array_make")
+      (export "caml_uniform_array_make")
       (param $n (ref eq)) (param $v (ref eq)) (result (ref eq))
       (local $sz i32) (local $b (ref $block)) (local $f f64)
       (local.set $sz (i31.get_s (ref.cast (ref i31) (local.get $n))))